S
SHAWTY721 via AccessMonster.com
I am trying to send the results of a query that runs when a button is clicked
on a form. Originally I used teh DoCmd.TransferSpreadsheet to export the
information but I was informed that by using the DoCmd.TransferSpreadsheet
method you are unable to dictate which fields records should go to so I
created a Public Function. I receive this error when I click the button:
Run-time error ‘3075’:
Syntax error in date in query expression ‘PG = ‘RYU’ AND LOCATION# = ‘63’ AND
CHECK_DT = ‘9/1/2007’ & ‘9/30/2007;’
This is what my function looks like:
on a form. Originally I used teh DoCmd.TransferSpreadsheet to export the
information but I was informed that by using the DoCmd.TransferSpreadsheet
method you are unable to dictate which fields records should go to so I
created a Public Function. I receive this error when I click the button:
Run-time error ‘3075’:
Syntax error in date in query expression ‘PG = ‘RYU’ AND LOCATION# = ‘63’ AND
CHECK_DT = ‘9/1/2007’ & ‘9/30/2007;’
This is what my function looks like:
Code:
Public Function ExportQuery() As String
On Error GoTo err_Handler
'Excel object variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim sTemplate As String
Dim sTempFile As String
Dim sOutput As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sSQL As String
Dim IRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer
Const cTabOne As Byte = 1
Const cTabTwo As Byte = 2
Const cStartRow As Byte = 3
Const cStartColumn As Byte = 1
DoCmd.Hourglass True
'Set to break on all errors
Application.SetOption "Error Trapping", 0
'Start with clean file built from template file
sTemplate = CurrentProject.Path & "\JournalEntryTest.xls"
sOutput = CurrentProject.Path & "\JournalEntryFormTest.xls"
If Dir(sOutput) <> "" Then Kill sOutput
FileCopy sTemplate, sOutput
'Create the Excel Application, Workbook and Worksheet and Database object
Set appExcel = New Excel.Application
appExcel.Visible = True
Set wbk = appExcel.Workbooks.Open(sOutput)
sSQL = "SELECT * FROM tblAllPerPayPeriodEarnings " & vbCrLf & "WHERE PG =
'" & Forms("frmJE").Controls("cboADPCompany").Value & "' AND LOCATION# = '" &
Forms("frmJE").Controls("cboLocationNo").Value & "' AND CHECK_DT = '" & Forms
("frmJE").Controls("txtFrom").Value & "' & '" & Forms("frmJE").Controls
("txtTo").Value & ";"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
If Not rst.BOF Then
rst.MoveFirst
'For this template, the data must be placed in the appropriate cells of the
spreadsheet
Do While Not rst.EOF
With wbk
.Sheets("JournalEntry").Range("G3") = rst.Fields("Branch Number")
.Sheets("JournalEntry").Range("K15") = rst.Fields("Account")
.Sheets("JournalEntry").Range("L15") = rst.Fields("Sub Account")
.Sheets("JournalEntry").Range("O15") = rst.Fields("SUMOfGROSS")
.Sheets("JournalEntry").Range("Q15") = rst.Fields("Account
Description")
.Sheets("JournalEntry").Range("G3,K15,L15,O15,Q15").Columns.
AutoFit
.SaveAs CurrentProject.Path & "\" & rst.Fields("Branch
Number&""&Description") & " .xls"
End With
rst.MoveNext
Loop
rst.Close
ExportQuery = "Total of " & IRecords & " rows processed."
exit_Here:
'Cleanup all objects (resume next on errors)
Set wbk = Nothing
appExcel.Quit
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
Exit Function
err_Handler:
ExportQuery = Err.Description
Resume exit_Here
End If
End Function
[\Code]