Item not found in this collection

[MJ8]

Hi

I have whacked together a code from my limited knowledge to run some queries using parameters in a table then export the query results onto excel with different sheets.

However I am getting an error message 'Item not found in this collection'. I believe it has to do with not being able to find fields from the table but when I check the table the field names appear to be correct. There must be something else I am missing (or many things). Is anyone able to offer solution as I am stuck.

Sub RunReportsToExcel()
Dim sql As String
Dim Query_Name As String
Dim Excel_Sheet As String
Dim Cell_Address As String
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim objQDF As DAO.QueryDef
Dim strcXLPath As String
'Dim strcXLTarget As String
Dim objXL As Excel.Application
Dim objWBK As Excel.Workbook
Dim objWS As Excel.Worksheet
Dim objRNG As Excel.Range
'Dim strcQueryName As String
sql = "Select [Query_Name], [Excel_Sheet], [Cell_Address] from Data_Quality_Report_Parameters;"

On Error GoTo Error_Exit_RunReportsToExcel
Set db = CurrentDb
Set rst = db.OpenRecordset(sql)
Set objQDF = db.QueryDefs("data1")

strcXLPath = "C:\temp\Template_data_quality_tabs_Camden.xls"
'strcXLTarget = "C:\temp\Data_quality_tabs_Camden_20120321.xls"

Do Until rst.EOF
Query_Name = rst("Query_Name")
Excel_Sheet = rst("Excel_Sheet")
Cell_Address = rst("Cell_Address")
' Open Excel and point to the cell where
' the recordset is to be inserted:
Set objQDF = db.QueryDefs("Query_Name")
Set objXL = New Excel.Application
objXL.Visible = True
Set objWBK = objXL.Workbooks.Open(strcXLPath)
Set objWS = objWBK.Worksheets("Excel_Sheet")
Set objRNG = objWS.Range("Cell_Address")
objRNG.CopyFromRecordset rst
' Save and close excel workbook
objWBK.SaveAs strcXLPath
objWBK.Close

' Destroy objects:
GoSub CleanUp
CleanUp:
' Destroy Excel objects:
Set objRNG = Nothing
Set objWS = Nothing
Set objWBK = Nothing
Set objXL = Nothing

' Destroy DAO objects:
If Not rst Is Nothing Then
rst.Close
Set rst = Nothing
End If
Set objQDF = Nothing
Set db = Nothing

Return

rst.MoveNext
Loop
Error_Exit_RunReportsToExcel:
MsgBox "Error " & Err.Number _
& vbNewLine & vbNewLine _
& Err.Description, _
vbExclamation + vbOKOnly, _
"Error Information"

GoSub CleanUp
Exit Sub
'Resume Exit_RunReportsToExcel
End Sub

 

[spikepl]

You have been too liberal with the quotes:

Set objQDF = db.QueryDefs("Query_Name")
Set objXL = New Excel.Application
objXL.Visible = True
Set objWBK = objXL.Workbooks.Open(strcXLPath)
Set objWS = objWBK.Worksheets("Excel_Sheet")
Set objRNG = objWS.Range("Cell_Address")

You are feeding the literal strings into the arguments above, instead of the intended content of each variable.

Also, when you get an error remember to indicate in what line, otherwise your supporters are left guessing.