I am trying to export a parameter query into a template excel sheet. If I run the query as a select query, the code runs perfectly, however I can seem to find the right code to do this as a parameter query. What eventually I would like to do, is have this execute from a combo box on a form.
The code is as follows. (this code is not mine, I found it and tweaked it so far for my needs)
Private Sub Command7_Click()
Const strcXLPath As String = "C:\\united lacrosse\teamtemp.xlsx"
Const strcWorksheetName As String = "Sheet1"
Const strcCellAddress As String = "A6"
Const strcQueryName As String = "qtestexport"
Dim objXL As Excel.Application
Dim objWBK As Excel.Workbook
Dim objWS As Excel.Worksheet
Dim objRNG As Excel.Range
Dim objDB As DAO.Database
Dim objQDF As DAO.QueryDef
Dim objrs As DAO.Recordset
'Dim objrs As Recordset
On Error GoTo Error_Exit_SaveRecordsetToExcelRange
Set objDB = CurrentDb()
Set objQDF = objDB.QueryDefs(strcQueryName)
Set objrs = objQDF.OpenRecordset
Set objQDF = CurrentDb.QueryDefs(strcQueryName)
' Sql = "SELECT GeneralInfo.[Helmet] , GeneralInfo.[LastName], GeneralInfo.[FirstName], GeneralInfo.Positions, GeneralInfo.Grade, GeneralInfo.highschool, GeneralInfo.[Phone Number], GeneralInfo.Address, GeneralInfo.City, GeneralInfo.State, GeneralInfo.[ZipCode] FROM GeneralInfo WHERE (((GeneralInfo.[Select Teams] = Me.[SelectTeam])))"
Set objXL = New Excel.Application
objXL.Visible = True
Set objWBK = objXL.Workbooks.Open(strcXLPath)
Set objWS = objWBK.Worksheets(strcWorksheetName)
Set objRNG = objWS.Range(strcCellAddress)
objRNG.CopyFromRecordset objrs
GoSub CleanUp
Exit_SaveRecordsetToExcelRange:
Exit Sub
CleanUp:
Set objRNG = Nothing
Set objWS = Nothing
Set objWBK = Nothing
Set objXL = Nothing
If Not objrs Is Nothing Then
objrs.Close
Set objrs = Nothing
End If
Set objQDF = Nothing
Set objDB = Nothing
Return
Error_Exit_SaveRecordsetToExcelRange:
MsgBox "Error " & Err.Number _
& vbNewLine & vbNewLine _
& Err.Description, _
vbExclamation + vbOKOnly, _
"Error Information"
GoSub CleanUp
Resume Exit_SaveRecordsetToExcelRange
End Sub
If I try to run this as a parameter query it bombs on : Set objrs = objQDF.OpenRecordset
I have tried many things to make this work but have been unable to code this correctly to do so.
Any suggestions for solutions will be greatly appreciated.
Thx
John
The code is as follows. (this code is not mine, I found it and tweaked it so far for my needs)
Private Sub Command7_Click()
Const strcXLPath As String = "C:\\united lacrosse\teamtemp.xlsx"
Const strcWorksheetName As String = "Sheet1"
Const strcCellAddress As String = "A6"
Const strcQueryName As String = "qtestexport"
Dim objXL As Excel.Application
Dim objWBK As Excel.Workbook
Dim objWS As Excel.Worksheet
Dim objRNG As Excel.Range
Dim objDB As DAO.Database
Dim objQDF As DAO.QueryDef
Dim objrs As DAO.Recordset
'Dim objrs As Recordset
On Error GoTo Error_Exit_SaveRecordsetToExcelRange
Set objDB = CurrentDb()
Set objQDF = objDB.QueryDefs(strcQueryName)
Set objrs = objQDF.OpenRecordset
Set objQDF = CurrentDb.QueryDefs(strcQueryName)
' Sql = "SELECT GeneralInfo.[Helmet] , GeneralInfo.[LastName], GeneralInfo.[FirstName], GeneralInfo.Positions, GeneralInfo.Grade, GeneralInfo.highschool, GeneralInfo.[Phone Number], GeneralInfo.Address, GeneralInfo.City, GeneralInfo.State, GeneralInfo.[ZipCode] FROM GeneralInfo WHERE (((GeneralInfo.[Select Teams] = Me.[SelectTeam])))"
Set objXL = New Excel.Application
objXL.Visible = True
Set objWBK = objXL.Workbooks.Open(strcXLPath)
Set objWS = objWBK.Worksheets(strcWorksheetName)
Set objRNG = objWS.Range(strcCellAddress)
objRNG.CopyFromRecordset objrs
GoSub CleanUp
Exit_SaveRecordsetToExcelRange:
Exit Sub
CleanUp:
Set objRNG = Nothing
Set objWS = Nothing
Set objWBK = Nothing
Set objXL = Nothing
If Not objrs Is Nothing Then
objrs.Close
Set objrs = Nothing
End If
Set objQDF = Nothing
Set objDB = Nothing
Return
Error_Exit_SaveRecordsetToExcelRange:
MsgBox "Error " & Err.Number _
& vbNewLine & vbNewLine _
& Err.Description, _
vbExclamation + vbOKOnly, _
"Error Information"
GoSub CleanUp
Resume Exit_SaveRecordsetToExcelRange
End Sub
If I try to run this as a parameter query it bombs on : Set objrs = objQDF.OpenRecordset
I have tried many things to make this work but have been unable to code this correctly to do so.
Any suggestions for solutions will be greatly appreciated.
Thx
John