china99boy
Registered User.
- Local time
- Today, 16:18
- Joined
- Apr 27, 2006
- Messages
- 161
Hi guys, I know this is an old post, but I have been struggling with this for sometime and can't seem to get it right. I have a procedure that I export to excel which worked great until I tried to add a mulit select box to the form that previously just had a date range to select from. I am trying to use the code found here and added the following code below to try to make it work. I am getting a run-time erro '2465' Microsoft Office Access can't find the field 'ENTERBY' referred to in your expression. It highlights "Me![ENTERBY] = strCriteria"
"Enterby" is the name of field in my table, but it is reference in the query. Please can someone help me resolve this problem?
Thanks
Public Function ExportRequest() As String
' 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 qd As DAO.QueryDef ' Added 10/06/07
Dim sSql As String
Dim lRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer
Dim strMacroName As String
Dim strMacroName2 As String
Dim strMacroName3 As String
Dim strFileName As String
Dim varItem As Variant
Dim strCriteria As String
strMacroName = "DeleteBlank"
strMacroName2 = "AutoFitAll"
strMacroName3 = "SetPrintArea"
strFileName = "R:\AOOutput.xls"
Const cTabOne As Byte = 1
Const cStartRow As Byte = 4
Const cStartColumn As Byte = 1
DoCmd.Hourglass True
' set to break on all errors
Application.SetOption "Error Trapping", 0
' start with a clean file built from the template file
sTemplate = "R:\AOTemplate.xls"
sOutput = "R:\AOOutput.xls"
If Dir(sOutput) <> "" Then Kill sOutput
FileCopy sTemplate, sOutput
' Create the Excel Applicaiton, Workbook and Worksheet and Database object
Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Open(sOutput)
Set wks = appExcel.Worksheets(cTabOne)
sSql = "select * from qryAOSummary"
Set dbs = CurrentDb
Set qd = dbs.QueryDefs("qryAOSummary")
qd.Parameters![txtStartDate] = [Forms]![frmMonthEndRpt]![txtStartDate]
qd.Parameters![txtEndDate] = [Forms]![frmMonthEndRpt]![txtEndDate]
For Each varItem In Me!lstEnterBy.ItemsSelected
strCriteria = strCriteria & ",'" & Me!lstEnterBy.ItemData(varItem) & "'"
Next varItem
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything from the list", vbExclamation, "Nothing to find!"
End If
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
Me![ENTERBY] = strCriteria
Set rst = qd.OpenRecordset
If Not rst.BOF Then rst.MoveFirst
' For this template, the data must be placed on the 4th row, third column.
' (these values are set to constants for easy future modifications)
iCol = cStartColumn
iRow = cStartRow
Do Until rst.EOF
iFld = 0
lRecords = lRecords + 1
Me.lblMsg.Caption = "Exporting record #" & lRecords & " to AoOutput.xls"
Me.Repaint
For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
wks.Cells(iRow, iCol) = rst.Fields(iFld)
If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
End If
wks.Cells(iRow, iCol).WrapText = False
iFld = iFld + 1
Next
wks.Rows(iRow).EntireRow.AutoFit
iRow = iRow + 1
rst.MoveNext
Loop
ExportRequest = "Total of " & lRecords & " rows processed."
Me.lblMsg.Caption = "Total of " & lRecords & " rows processed."
'Inserts Month,Year format based on entry in start date field.
wks.Range("A2").Value = [Forms]![frmMonthEndRpt]![txtStartDate]
'The Application.Run will run the Macro(s) that you saved in your spreadsheet
wks.Application.Run "'" & strFileName & "'!" & strMacroName
wks.Application.Run "'" & strFileName & "'!" & strMacroName2
exit_Here:
' Cleanup all objects (resume next on errors)
On Error Resume Next
Set wks = Nothing
Set wbk = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
Exit Function
End Function
"Enterby" is the name of field in my table, but it is reference in the query. Please can someone help me resolve this problem?
Thanks
Public Function ExportRequest() As String
' 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 qd As DAO.QueryDef ' Added 10/06/07
Dim sSql As String
Dim lRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer
Dim strMacroName As String
Dim strMacroName2 As String
Dim strMacroName3 As String
Dim strFileName As String
Dim varItem As Variant
Dim strCriteria As String
strMacroName = "DeleteBlank"
strMacroName2 = "AutoFitAll"
strMacroName3 = "SetPrintArea"
strFileName = "R:\AOOutput.xls"
Const cTabOne As Byte = 1
Const cStartRow As Byte = 4
Const cStartColumn As Byte = 1
DoCmd.Hourglass True
' set to break on all errors
Application.SetOption "Error Trapping", 0
' start with a clean file built from the template file
sTemplate = "R:\AOTemplate.xls"
sOutput = "R:\AOOutput.xls"
If Dir(sOutput) <> "" Then Kill sOutput
FileCopy sTemplate, sOutput
' Create the Excel Applicaiton, Workbook and Worksheet and Database object
Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Open(sOutput)
Set wks = appExcel.Worksheets(cTabOne)
sSql = "select * from qryAOSummary"
Set dbs = CurrentDb
Set qd = dbs.QueryDefs("qryAOSummary")
qd.Parameters![txtStartDate] = [Forms]![frmMonthEndRpt]![txtStartDate]
qd.Parameters![txtEndDate] = [Forms]![frmMonthEndRpt]![txtEndDate]
For Each varItem In Me!lstEnterBy.ItemsSelected
strCriteria = strCriteria & ",'" & Me!lstEnterBy.ItemData(varItem) & "'"
Next varItem
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything from the list", vbExclamation, "Nothing to find!"
End If
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
Me![ENTERBY] = strCriteria
Set rst = qd.OpenRecordset
If Not rst.BOF Then rst.MoveFirst
' For this template, the data must be placed on the 4th row, third column.
' (these values are set to constants for easy future modifications)
iCol = cStartColumn
iRow = cStartRow
Do Until rst.EOF
iFld = 0
lRecords = lRecords + 1
Me.lblMsg.Caption = "Exporting record #" & lRecords & " to AoOutput.xls"
Me.Repaint
For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
wks.Cells(iRow, iCol) = rst.Fields(iFld)
If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
End If
wks.Cells(iRow, iCol).WrapText = False
iFld = iFld + 1
Next
wks.Rows(iRow).EntireRow.AutoFit
iRow = iRow + 1
rst.MoveNext
Loop
ExportRequest = "Total of " & lRecords & " rows processed."
Me.lblMsg.Caption = "Total of " & lRecords & " rows processed."
'Inserts Month,Year format based on entry in start date field.
wks.Range("A2").Value = [Forms]![frmMonthEndRpt]![txtStartDate]
'The Application.Run will run the Macro(s) that you saved in your spreadsheet
wks.Application.Run "'" & strFileName & "'!" & strMacroName
wks.Application.Run "'" & strFileName & "'!" & strMacroName2
exit_Here:
' Cleanup all objects (resume next on errors)
On Error Resume Next
Set wks = Nothing
Set wbk = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
Exit Function
End Function