Exporting multiple reports into one excel workbook

[nosferatu26]

Hello,

I have several reports that I've created that each have a button in them that will export that report to its own excel file and then format it accordingly. Ideally, instead I would like to have one button somewhere that will export all of these reports into a single workbook, but each report would be its own worksheet within that workbook.

Below is my code for one of the buttons:

 'This button will export the report into a formatted excel spreadsheet
'It automatically saves it to the users desktop and will overwrite already existing versions when pressed
Private Sub exportButton_Click()
    On Error GoTo Err_export
    Dim lngRcdCt As Long
    Dim strWorkSheetPath As String
    'Get a total record count without having a textfield in the headers/footers.
    'for some reason, whenever a textfield was on the report, the filter buttons didn't work.
    Set db = CurrentDb()
    Set rs = db.OpenRecordset(Me.Report.RecordSource)
    rs.MoveLast
    lngRcdCt = rs.RecordCount
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    
    strWorkSheetPath = "C:\Users\" & GetUserName() & "\Desktop\"
    strWorkSheetPath = strWorkSheetPath & "SECTION_D.xls"
    Dim objActiveWkb As Object, appExcel As Object
    If Not Dir(strWorkSheetPath) = "" Then
        Kill strWorkSheetPath 'delete previous version
    End If
    DoCmd.OutputTo acOutputReport, "Section D - Part Type by Ref Des", acFormatXLS, strWorkSheetPath, 0 'export current report
    'declare new excel object
    Set appExcel = CreateObject("Excel.Application")
    'assign to newly exported spreadsheet
    appExcel.Application.Workbooks.Open (strWorkSheetPath)
    Set objActiveWkb = appExcel.Application.ActiveWorkbook
    appExcel.Visible = True
    'format
    With objActiveWkb
        .Worksheets(1).Cells.Select
        .Worksheets(1).Columns("A:A").ColumnWidth = 15
        .Worksheets(1).Columns("B:B").ColumnWidth = 49
        .Worksheets(1).Columns("C:C").ColumnWidth = 26
        .Worksheets(1).Columns("D:D").ColumnWidth = 15
        .Worksheets(1).Columns("E:E").ColumnWidth = 16
        .Worksheets(1).Cells.Rows.AutoFit
        .Worksheets(1).Cells.Font.Size = 10
        .Worksheets(1).Cells.Font.Name = "Arial"
        .Worksheets(1).Cells.WrapText = True
        .Worksheets(1).Cells.Font.Color = xlAutomatic
        .Worksheets(1).Rows(1).Font.Bold = True
        .Worksheets(1).Rows(1).AutoFilter
        With .Worksheets(1).PageSetup
            .LeftHeader = "&BDrawing Title: XXXXXXXX"
            .CenterHeader = vbCr & "&16&BSection D - Part Type by Ref Des"
            .RightHeader = "&12&BDocument Number: 123456" & vbCr & "&10Revision Letter:??"
            .CenterFooter = vbCr & "&16&BSection D - Part Type by Ref Des" & vbCr
            .RightFooter = "Page &P of &N"
        End With
        
        .Worksheets(1).Range("A1:E" & lngRcdCt + 1).BorderAround LineStyle:=1, Weight:=4 '1 = xlContinuous ; 4 = xlThick
        .Worksheets(1).Range("B" & lngRcdCt + 2).Value = "-End-"
        .Worksheets(1).Range("B" & lngRcdCt + 2).HorizontalAlignment = -4152 '-4152 = xlRight value
        .Worksheets(1).Range("A1").Borders(10).Weight = 2 '10 = xlEdgeRight
        .Worksheets(1).Range("B1").Borders(10).Weight = 2
        .Worksheets(1).Range("C1").Borders(10).Weight = 2
        .Worksheets(1).Range("D1").Borders(10).Weight = 2 '2 = xlThin
        appExcel.Rows(1).Borders(8).Weight = -4138 '8 = xlEdgeTop value ; -4138 = xlMedium value
        appExcel.Rows(1).Borders(9).Weight = -4138 '9 = xlEdgeBottom value
        appExcel.Rows(lngRcdCt + 1).Borders(9).Weight = -4138 '9 = xlEdgeBottom value
        appExcel.Rows(1).Select
        appExcel.Names.Add Name:="Print_Titles", RefersToR1C1:= _
            "='Section D - Part Type by Ref De'!R1"
       
    objActiveWkb.Close savechanges:=True
    'appExcel.Visible = True
    appExcel.Workbooks.Open strWorkSheetPath, True, False
    Set objActiveWkb = Nothing: Set appExcel = Nothing
    'MsgBox ("Export successful")
    End With
    Exit Sub
Err_export:
    Call TerminateProcess
    MsgBox ("Error. Please try again.")
End Sub

I apologize if the code is messy; most of the code for the other section reports is the same, with a few formatting differences. I just don't know how to pull the data from one report into a new worksheet. I was messing around on google/trying things with "DoCmd.OutputTo acOutputReport" but can't seem to have any luck. If anyone can help me out with this it would be greatly appreciated!

 

[Ranman256]

First export them each to its own tab,
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, vQry1, vFile, True, "sheet1"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, vQry2, vFile, True, "sheet2"

THEN, open excel with the appExcel object and format.

 

[nosferatu26]

Do you know how I could pass the queries to from outside reports? For the hosted report I used:

 Set db = CurrentDb()
Set rs = db.OpenRecordset(Me.Report.RecordSource)

I have each query used saved in the "Queries" section of the "All Access Objects" schema on the left side of the screen. I am just unsure how to properly call them in VBA within a sub.

 

[nosferatu26]

Also, I tried hardcoding the query into it to see if it worked and it is giving me the error: "The table name you entered doesn't follow access object naming rules".

 

[sneuberg]

DoCmd.TransferSpreadsheet doesn't work with queries and unfortunately you cannot specify a sheet or cell with DoCmd.OutputTo. Below is some code that might get you started in the direction you want to go.

Public Sub ExportXLData(QueryName As String, xlFilePath As String, Optional xlSheetName As String = "Sheet1", Optional xlCell As String = "A1")

Dim wb As Object
Dim ws As Object
Dim XL As Object
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset(QueryName)
Set XL = CreateObject("Excel.Application")
Set wb = XL.Workbooks.Open(xlFilePath)
Set ws = wb.Sheets(xlSheetName)
ws.Range(xlCell).CopyFromRecordset rs
Set ws = Nothing
wb.Save
wb.Close
rs.Close
db.Close
Set wb = Nothing
Set XL = Nothing

   

End Sub

This could be improved by adding some error checking.

 

[nosferatu26]

I seem to be getting a subscript out of range error now. it's being caused from the
"Set ws = wb.Sheets(xlSheetName)" line. I googled the error and tried the suggested resolutions from other forums but cant seem to have any luck.

 

[marlan]

Here is what you are looking for: http://btabdevelopment.com/export-a-table-or-query-to-excel-specific-worksheet-on-specific-workbook/
Send a RecordSet to an Excel sheet. You can find there other options too.

And here is another discussion on the topic.

ATB