Exort set of queries to excel

[SF]

Hi,

I am think of exporting a set of queries to excel but putting each result
set in different sheets, I try to put the code together but I don't know how
to go further, could someone help me to complete this task?


Public Function OutputReport(Qtr As String)
On Error GoTo ProcError

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim Stg As String
Dim QryStg As String

Set dbs = CurrentDb

QryStg = "SELECT [2-1-1-A By Qtr].FY, [2-1-1-A By Qtr].Qtr, [2-1-1-A By
Qtr].[Public Session], [2-1-1-A By Qtr].[# of Session]"
QryStg = QryStg & " FROM [2-1-1-A By Qtr] WHERE ((([2-1-1-A By Qtr].Qtr)=" &
Qtr & "));"

Set qdf = dbs.QueryDefs(QryStg)
Set rst = qdf.OpenRecordset(dbOpenDynaset, dbSeeChanges)


How to transfer the content of the queryset to excel here....

Set xlApp = CreateObject("Excel.Application")

xlApp.Visible = True
'xlApp.Visible = True
'' xlApp.ActiveWorkbook.PrintOut
'' 'xlApp.ActiveWorkbook.Saved = False
'' xlApp.ActiveWorkbook.Close SaveChanges:=False
'' xlApp.UserControl = False
'' 'Application.DisplayAlerts = False
'' xlApp.Quit

ExitProc:
'Cleanup
On Error Resume Next
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
rst.Close: Set rst = Nothing
dbs.Close: Set dbs = Nothing
Exit Function
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure PrintTravel..."
Resume ExitProc
Resume

End Function

SF

 

[pietlinden]

Hi,

I am think of exporting a set of queries to excel but putting each result
set in different sheets, I try to put the code together but I don't know how
to go further, could someone help me to complete this task?

<SNIP>
Wow... looks like you're doing this the hard way... Why not use
TransferSpreadsheet?

In my code, I have a list of queries in an array (just because it's
easier to loop over it) - you could use a recordset or whatever.

Here's the code...
basically all you have to do is create an array of items and then call
the TransferSeveralQueries function

Public Sub TransferSeveralQueries(varQueries As Variant, strXLFile As
String)
Dim iSheet As Integer
For iSheet = LBound(varQueries) To UBound(varQueries)
ExportQueryResultToExcel varQueries(iSheet), strXLFile,
"Sheet" & iSheet
Next iSheet

End Sub

Sub ExportQueryResultToExcel(ByVal strQueryName As String, ByVal
strXLFile As String, ByVal strSheet As String)

'strQueryName: the name of the query you want to export
'strXLFile: the file name (full path!) to which you want to export the
results
'strSheet: the Sheet name in the XL file you want to export to

DoCmd.TransferSpreadsheet acExport, 8, strQueryName, strXLFile,
True, strSheet
End Sub

 

[Ken Snell \(MVP\)]

See this article:

Create a Query and Export multiple "filtered" versions of a Query (based on
data in another table) to separate Worksheets within one EXCEL file via
TransferSpreadsheet
http://www.accessmvp.com/KDSnell/EXCEL_ImpExp.htm#FilterExportSameFile

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/

Hi,

I am think of exporting a set of queries to excel but putting each result
set in different sheets, I try to put the code together but I don't know
how to go further, could someone help me to complete this task?


Public Function OutputReport(Qtr As String)
On Error GoTo ProcError

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim Stg As String
Dim QryStg As String

Set dbs = CurrentDb

QryStg = "SELECT [2-1-1-A By Qtr].FY, [2-1-1-A By Qtr].Qtr, [2-1-1-A By
Qtr].[Public Session], [2-1-1-A By Qtr].[# of Session]"
QryStg = QryStg & " FROM [2-1-1-A By Qtr] WHERE ((([2-1-1-A By Qtr].Qtr)="
& Qtr & "));"

Set qdf = dbs.QueryDefs(QryStg)
Set rst = qdf.OpenRecordset(dbOpenDynaset, dbSeeChanges)


How to transfer the content of the queryset to excel here....

Set xlApp = CreateObject("Excel.Application")

xlApp.Visible = True
'xlApp.Visible = True
'' xlApp.ActiveWorkbook.PrintOut
'' 'xlApp.ActiveWorkbook.Saved = False
'' xlApp.ActiveWorkbook.Close SaveChanges:=False
'' xlApp.UserControl = False
'' 'Application.DisplayAlerts = False
'' xlApp.Quit

ExitProc:
'Cleanup
On Error Resume Next
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
rst.Close: Set rst = Nothing
dbs.Close: Set dbs = Nothing
Exit Function
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure PrintTravel..."
Resume ExitProc
Resume

End Function

SF