A family of Microsoft relational database management systems designed for ease of use.
Bob, I am trying to do something very similar as what is referred to in these posts. I don't fully grasp all the VBA but copied the info into my own database. I have 3 queries that I am trying to export to a single Excel workbook, each query placed into its own sheet in that workbook. Here is a copy of my code (still in testing phase, so file is on my desktop):
Private Sub cmdBenderExport_Click()
Call SendTQ2XLWbSheet("qryBenderEfficiencies_Crosstab", "qryBenderEfficiencies_Crosstab", "C:\Users\A\Desktop\ASXX\Mfg Data\BenderCharts.xlsm")
Call SendTQ2XLWbSheet("qryBenderEffic-Mo_Crosstab", "qryBenderEffic_Mo_Crosstab", "C:\Users\A\Desktop\ASXX\Mfg Data\BenderCharts.xlsm")
Call SendTQ2XLWbSheet("qryBenderEffic-Wk_Crosstab", "qryBenderEffic_Wk_Crosstab", "C:\Users\A\Desktop\ASXX\Mfg Data\BenderCharts.xlsm")
End Sub
Public Function SendTQ2XLWbSheet(strTQName As String, strSheetName As String, strFilePath As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
' strFilePath is the name and path of the file you want to send this data into.
Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As Field
Dim blnSaveAs As Boolean
Dim i As Long
Dim strPath As String
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
On Error GoTo err_handler
strPath = strFilePath
Set rst = CurrentDb.OpenRecordset(strTQName)
If rst.RecordCount = 0 Then
MsgBox "There are no records to export"
Exit Function
End If
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Open(strPath)
ApXL.Visible = True
Set xlWSh = xlWBk.Worksheets(strSheetName)
xlWSh.Cells.Clear
For i = 0 To rst.Fields.Count - 1
xlWSh.Cells(1, i + 1) = rst.Fields(i).Name
Next i
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
' does the "autofit" for all columns
xlWSh.Cells.EntireColumn.AutoFit
rst.Close
Set rst = Nothing
ApXL.DisplayAlerts = False
If Dir(strFilePath) = "" Then
xlWBk.SaveAs strFilePath
Else
xlWBk.Save
End If
xlWBk.Close
ApXL.DisplayAlerts = True
ApXL.Quit
Set ApXL = Nothing
Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
End Function
One of the queries works fine, as there is no criteria for that. The other two require a range of dates. Here is a sample of one of the criteria: Between [Forms]![frmMainMenu]![txt6WksEarlier] And [forms]![frmMainMenu]![txtDate].
I am getting Error 3061 "Too few parameters. Expected 2" for both of these queries, and of course no results show up in the workbook for these two queries.