Here's some VBA code that I wrote a while back for a poster who wanted to
filter various data and export the different sets of filtered data to
worksheets within one EXCEL worksheet. Modify the table/query and field
names to match your specific situation.
The reason for this approach is because you cannot use a "parameter" query
(such as one that uses a reference to a form's control) in the
TransferSpreadsheet action. So you must create a filtered query, save it,
and then use it for the export to EXCEL.
Post back if you have difficulty modifying the code to fit your situation,
post back with more details about your table/query and field names.
Generic code to create a temporary query, get list of
filtering values, and then loop through the list to filter
various data and export each filtered query to separate
worksheets in a single EXCEL file
----------------------------------------------------------
'Start of code
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstMgr As DAO.Recordset
Dim strSQL As String, strTemp As String, strMgr As String
Const strFileName As String = "PutEXCELFileNameHereWithout.xls"
Const strQName As String = "zExportQuery"
Set dbs = CurrentDb
' Create temporary query that will be used for exporting data;
' give it a dummy SQL statement initially
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName
' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID, EmployeesTable need to
' *** be changed to your table and field names
' Get list of manager IDs -- note: replace my generic table and field
names
' with the real names of the employees table and the manager ID field
strSQL = "SELECT DISTINCT ManagerID FROM EmployeesTable;"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
' Now loop through list of manager IDs and create a query for each ID
' so that the data can be exported -- the code assumes that the actual
names
' of the managers are in a lookup table -- again, replace generic names
with
' real names of tables and fields
If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False
' *** code to set strMgr needs to be changed to conform to your
' *** database design -- ManagerNameField, ManagersTable,
' *** ManagerID need to be changed to your table and field names
' *** be changed to your table and field names
strMgr = DLookup("ManagerNameField", "ManagersTable", _
"ManagerID = " & rstMgr!ManagerID.Value)
' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID, EmployeesTable need to
' *** be changed to your table and field names
strSQL = "SELECT * FROM EmployeesTable WHERE " & _
"ManagerID = " & rstMgr!ManagerID.Value & ";"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "q_" & strMgr
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing
' Replace C:\FolderName\ with actual path
DoCmd.TranferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTemp, "C:\FolderName\" & strFileName & ".xls"
rstMgr.MoveNext
Loop
End If
rstMgr.Close
Set rstMgr = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
'End of code
--
Ken Snell
<MS ACCESS MVP>
Hi,
I'm trying to figure it out why it won't work. I hope you can help me
out.
I have a button where I click to export excel. I would not allow me
to put the filter under the query like [forms].[Form1].cboList. I
have about approx 2,000 records. I want to pull 125 "Purchasing"
records out of 2,000 records and export 125 records to excel
spreadsheet below (code). it kept stop there without export data to
excel.
Set ExportTables = db.OpenRecordset "tblReportName")
'make sure at start of table
ExportTables.MoveFirst
'Use the recordset as a base
With ExportTables
' Process until end of file
Do While Not .EOF
'get the name of the query
strQueryName = ExportTables("Query")
'get the name of the worksheet
strWorksheet_Name = ExportTables("Worksheet")
' Open a recordset on the query for the data to export
Set CopyData_Query = db.OpenRecordset(strQueryName)
' If there are no records, return an error
If CopyData_Query.EOF Then
I would be appreciated very much if you can help me out.
Thanks
