exporting multiple queries to Excel

  • Thread starter Thread starter Mark
  • Start date Start date
M

Mark

I'm trying to export multiple queries to one Excel workbook
using VBA. I have a table containing the names of all the
queries I want to export, and I loop through the records in
the table and export them one at a time. The problem is
that every query exported overwrites the existing workbook
and/or worksheet, so in the end I only have the results of
one query in Excel, instead of a separate tab for each
query. My code looks like this:

For iQuery = 1 To 2 'rcdsQueries.RecordCount

sQuery = rcdsQueries.Fields("QueryName")
DoCmd.OutputTo acOutputQuery, sQuery,
"MicrosoftExcel(*.xls)", sXLSFileName, False, ""

rcdsQueries.MoveNext

Next iQuery

How can I get the results of each query to show up in a
separate tab. Thanks in advance.

Mark
 
I think you are trying to go beyond the capabilities of the outputto method. You should go to using Automation to create an excel objects and send data using the excel copyrecordset method.

Here is some code i use. may be more then you need. This procedure has one parameter that takes a single name of a query or table or an array of query/table names, each separate query/table will be put into a new sheet in excel.

Sub SendToExcel(Optional RecName As Variant)
Dim xlApp As Object ' Declare variable to hold the reference.
Dim rst As Recordset, w, x, y, CurName
If IsMissing(RecName) Then
RecName = "DMFinal"
End If
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xlApp.Workbooks.Add
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseClient
If IsArray(RecName) Then
y = UBound(RecName)
End If
For x = 1 To y
If IsArray(RecName) Then
CurName = RecName(x)
Else
CurName = RecName
End If
If x > 1 Then
xlApp.ActiveWorkbook.Sheets.Add , xlApp.activesheet
End If
xlApp.activesheet.Name = CurName
rst.Open CurName, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

' You may have to set Visible property to True
' if you want to see the application.

For w = 0 To rst.Fields.Count - 1
xlApp.Range("A1").offset(0, w) = rst(w).Name
If InStr(1, rst(w).Name, "DATE") > 0 Then
xlApp.Range("A1").offset(0, w).EntireColumn.NumberFormat = "m/d/yy"
End If
Next
xlApp.Range("A2").CopyFromRecordset rst
xlApp.Cells.EntireColumn.AutoFit
rst.Close
Next

xlApp.ActiveWorkbook.SaveAs ("G:\Finance\Findb\AcctstoZero" & Format(GetCurrentDate(), "mmddyy") & ".xls")
xlApp.ActiveWorkbook.Close
Set xlApp = Nothing

Set xlApp = Nothing
End Sub
 
Back
Top