(Solved) Export To Excel Workbook With Multiple Spreadsheets

[Samnuni]

Hi all, with the thread: http://www.mrexcel.com/board2/viewtopic.php?t=280561&highlight=excel+vba I was able to export to files. Is it possible to export to multiple spreadsheets?

I basically have call the export multiple times:
DoCmd.OutputTo acOutputQuery, "Q Equipment Forecast A2", acFormatXLS, "C:\30 Days Forecasting Report.xls", False
DoCmd.OutputTo acOutputQuery, "Q Equipment Forecast B2", acFormatXLS, "C:\60 Days Forecasting Report.xls", False
DoCmd.OutputTo acOutputQuery, "Q Equipment Forecast C2", acFormatXLS, "C:\90 Days Forecasting Report.xls", False
DoCmd.OutputTo acOutputQuery, "Q Equipment Forecast D2", acFormatXLS, "C:\120 Days Forecasting Report.xls", False

I wish to export all of them to the same workbook but different speadsheets. Please advise.

Thanks in advance,

-- Sam

 

[Norie]

Sam

Just don't change the name of the file to export to.

DoCmd.OutputTo acOutputQuery, "Q Equipment Forecast A2", acFormatXLS, "C:\Forecasting Report.xls", False 
DoCmd.OutputTo acOutputQuery, "Q Equipment Forecast B2", acFormatXLS, "C:\Forecasting Report.xls", False 
DoCmd.OutputTo acOutputQuery, "Q Equipment Forecast C2", acFormatXLS, "C:\Forecasting Report.xls", False 
DoCmd.OutputTo acOutputQuery, "Q Equipment Forecast D2", acFormatXLS, "C:\Forecasting Report.xls", False

 

[Samnuni]

Thanks for the reply, but when I do that; there is only one spreadsheet there... the last one.

 

[Norie]

Oops my mistake.

Didn't see you were using OutputTo.

Use TransferSpreadsheet instead.

DoCmd.TransferSpreadsheet acExport, , "Q Equipment Forecast A2", "C:\Forecasting Report.xls"
DoCmd.TransferSpreadsheet acExport, , "Q Equipment Forecast B2", "C:\Forecasting Report.xls"
DoCmd.TransferSpreadsheet acExport, , "Q Equipment Forecast C2", "C:\Forecasting Report.xls"
DoCmd.TransferSpreadsheet acExport, , "Q Equipment Forecast D2", "C:\Forecasting Report.xls"

 

[Samnuni]

Thank you!

Just for future reference, when is a good time to use OutputTo? I noticed OutputTo preserves formatting while TransferSpreadsheet does not. Please advise.

-- Sam

 

[Norie]

Sam

I never use OutputTo.

It has various limitations, one of which you've discovered.

It may preserve some formatting but you can easily automate Excel from Access VBA to format as you like.

 

[NumbersMax]

Norie,

Any chance you could teach a class on the Excel automation from Access VBA subject?

Or maybe there's a good book on the subject?

Max

 

[Samnuni]

Norie,

Any chance you could teach a class on the Excel automation from Access VBA subject?

Or maybe there's a good book on the subject?

Max

Well, I use something like this for Excel macro under Access:

'Starts Excel
    Set xlapp = CreateObject("Excel.Application")

    xlapp.Workbooks.Open "C:\Forecasting Report.xls"

      ' If there is more than one macro called TestMacro,
      ' the module name would be required as in
      '
      ' XL.Run "Module1.TestMacro"
      '
      ' to differentiate which routine is being called.
      '
    xlapp.Run "ForecastingCleanUp"

Hope it helps.

-- Sam

 

[PsYc0TiC]

As I have learned in the last week...

In Access (using 2013)

DoCmd.OutputTo will export your table data with the table formatting but cannot run multiple queries and make multiple sheets.
DoCmd.TransferSpreadsheet will export your table data but without table formatting but can create multiple sheets. There is also another hiccup with this method pertaining to how your table relationships are designed that can cause the data transferred to be the ID number of some data rather than the actual data. not going to go into that since it was my table designs and relationships issue but is solvable in the query string.

With a lot of help from arnelgp on Access World Forums the following code works awesome to run multiple queries, export to Excel with various formatting and omit sheets if any of the queries return no data. If you don't need this it is easy to remove that portion of the code to output all sheets from all queries.

I recorded some macros in Excel to find the formatting code to add to the VB with minor edits to make it work. and of course you must set a reference in Access to the Microsoft Excel Object Library (in my case it was 15 (16 didn't work)). Don't forget to change your path, query names, sheet names etc.

Create a module and name it whatever you want:

Public Function fnLastRow(sh As Object)On Error Resume Next
        With sh
                fnLastRow = .Cells.Find(What:="*", _
                                After:=.Range("A1"), _
                                Lookat:=2, _
                                LookIn:=5, _
                                SearchOrder:=1, _
                                SearchDirection:=2, _
                                MatchCase:=False).Row
        End With
End Function

Then create your form with a button and use this code:

Private Sub Waiting_on_Visual_Click()


Const FileNameBase As String = "W:\Projects\User\Databases\Weekly Reports\Report [CurrentDate].xlsx"
    Dim strFileName As String
    strFileName = Replace(FileNameBase, "[CurrentDate]", Format$(Date, "m-dd-yyyy"))


If DCount("*", "AdvanceWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "AdvanceWaitVis", strFileName, True, "AdvanceWaitVis"
End If
If DCount("*", "ArcadiaWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "ArcadiaWaitVis", strFileName, True, "ArcadiaWaitVis"
End If
If DCount("*", "EcruWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "EcruWaitVis", strFileName, True, "EcruWaitVis"
End If
If DCount("*", "LeesportWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "LeesportWaitVis", strFileName, True, "LeesportWaitVis"
End If
If DCount("*", "RipleyWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "RipleyWaitVis", strFileName, True, "RipleyWaitVis"
End If
If DCount("*", "WanekWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "WanekWaitVis", strFileName, True, "WanekWaitVis"
End If
If DCount("*", "WanvogWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "WanvogWaitVis", strFileName, True, "WanvogWaitVis"
End If
If DCount("*", "WhitehallWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "WhitehallWaitVis", strFileName, True, "WhitehallWaitVis"
End If


Dim xlWB As Object
    Dim xlObj As Object
    Dim xlSheet As Object
    Dim lngRow As Long
    
    Set xlObj = CreateObject("Excel.Application")
    Set xlWB = xlObj.Workbooks.Open(strFileName, False, False)
    
    For Each xlSheet In xlWB.Worksheets
        
        With xlSheet
            
            .Activate
            lngRow = .Cells(.Rows.Count, 1).End(-4162).Row 'xlUp
            Debug.Print lngRow
            .Range("F1:F" & lngRow).Select
            xlObj.Selection.FormatConditions.Add Type:=2, Formula1:= _
                    "=TODAY()-F1>13"
            xlObj.Selection.FormatConditions(xlObj.Selection.FormatConditions.Count).SetFirstPriority
            With xlObj.Selection.FormatConditions(1).Interior
                .PatternColorIndex = -4105
                .Color = 255
                .TintAndShade = 0
            End With
            xlObj.Selection.FormatConditions(1).StopIfTrue = False
            .Range("A1:G1").Select
            With xlObj.Selection
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ReadingOrder = xlContext
                .MergeCells = False
                
                With .Font
                    .Name = "Calibri"
                    .FontStyle = "Bold"
                    .Size = 11
                End With
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                With .Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With .Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                With .Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = -0.14996795556505
                    .PatternTintAndShade = 0
                End With
            End With
            .Columns("A:A").Select
            xlObj.Selection.ColumnWidth = 8.3
            .Columns("B:B").Select
            xlObj.Selection.ColumnWidth = 28.86
            .Columns("C:C").Select
            xlObj.Selection.ColumnWidth = 13.29
            .Columns("D:D").Select
            xlObj.Selection.ColumnWidth = 12.57
            .Columns("E:E").Select
            xlObj.Selection.ColumnWidth = 13.57
            .Columns("F:F").Select
            xlObj.Selection.ColumnWidth = 11
            .Columns("G:G").Select
            xlObj.Selection.ColumnWidth = 13.29
            .Range("A1").Select
            xlObj.ActiveWindow.FreezePanes = False


                        
        End With


    Next
    xlObj.Sheets(1).Activate
    xlWB.Close True
    Set xlSheet = Nothing
    Set xlWB = Nothing
    xlObj.Quit
    Set xlObj = Nothing


End Sub

Up at the top of the code you can remove the below code snips from around each of the query calls to make it transfer all spreadsheets instead of omitting the ones with no data:

If DCount("*", "AdvanceWaitVis") > 0 Then
...
End If

Tweak the formatting to how you want yours displayed, number of colums etc. If you want more formatting, go to Excel and record some macros and convert them to vb code and add the information into the button code. They will need minor editing as you will see the differences between what you have recorded and what is in the above code.

Hope this helps everyone as much as it helped me.