Hi All,
A bit confounded on this one. I have a module setup which is intended to output a query recordset onto an Excel Workbook.
The query that I'm trying to pass into it is defined in a separate module using DAO.QueryDef. The SQL string and ODBC Connect String is also defined here.
The query itself looks fine, as I'm able to validate it after it creates the QueryDef object for it.
However, once I pass this onto the "Export To Excel Worksheet" module, I keep receiving a "No Current Record" error but I cannot seem to figure out why, as it still copies the data from the recordset and onto the Excel Worksheet as expected.
For what it's worth - if I tweak the code to have it pass in a pre-existing query from the database (rather than a QueryDef being defined through a separate module), I don't receive that error message.
Has anyone run into anything similar?
Code:
strFileName = "MyFile.xlsx"
strPath = "c:\users\me\desktop\"
strSQL = "SELECT * FROM MYTABLE"
strConnect = "ODBC;DSN=MyDB;UID=abc;PWD=123;DBQ=abc;DBA=W;APA=T;EXC=F;FEN=T;QTO=T;FRC=10;FDL=10;LOB=T;RST=T;BTD=F;BNF=F;BAM=IfAllSuccessful;NUM=NLS;DPM=F;MTS=T;MDI=F;CSR=F;FWC=F;FBS=64000;TLO=O;MLD=0;ODA=F;"
Set db = CurrentDb
Set qdef = db.CreateQueryDef(strQuery)
With qdef
.Connect = strConnect
.SQL = strSQL
.ReturnsRecords = True
End With
Set rs = db.OpenRecordset(strQuery)
If Not rs.EOF Then
Call Output_Query_To_Excel_Workbook(strQuery, "Pages", strFileName, strPath)
End If
This passes the query to the below function. When it gets to the bolded part, I receive the runtime error 3021 "No Current Record".. yet, it *does* successfully copy/paste the records from the query onto the Excel Worksheet. Thus, I'm a bit confused as to why I keep receiving the "No Current Record" error message.
Code:
Public Function Output_Query_To_Excel_Workbook(strQuery As String, strSheetName As String, strFileName As String, strPath As String)
Set db = CurrentDb
Set rs = db.OpenRecordset(strQuery)
Set XLApp = CreateObject("Excel.Application")
Set XLBook = XLApp.Workbooks.Add
XLApp.Visible = True
XLBook.Worksheets("Sheet1").Name = strSheetName
Set XLSheet = XLBook.Worksheets(strSheetName)
XLSheet.Activate
XLSheet.Range("A1").Select
For Each fld In rs.Fields 'Populate field headers on worksheet
XLApp.ActiveCell = fld.Name
XLApp.ActiveCell.Offset(0, 1).Select
Next
XLSheet.Range("A2").CopyFromRecordset rs
XLBook.SaveAs filename:=strPath & strFileName, FileFormat:=xlOpenXMLWorkbook
Set XLBook = Nothing
Set XLSheet = Nothing
rs.close
Set rs = Nothing