This doesn't work and it should. Any idea why?
xlApp.Range("A2").CopyFromRecordset (rs)
It tells me that the object is not automatable?
Thanks
Rusty
PS: here is all of the code
Public Sub ExportToExcel(strSQL As String)
On Error GoTo HandleErrors
Dim response As String
response = _
MsgBox("This action may take several minutes." & _
vbCrLf & "Do you wish to continue...?", _
vbQuestion + vbOKCancel)
If response = vbOK Then
DoCmd.Hourglass True
Dim rs As DAO.Recordset
Dim xlApp As New Excel.Application
Dim intCol As Integer
Dim strFileName As String
Set rs = CurrentDb.OpenRecordset(strSQL)
Set xlApp = Excel.Application
xlApp.Workbooks.Add
'Add header row to spreadsheet
For intCol = 0 To rs.Fields.Count - 1
xlApp.Cells(1, intCol + 1).Value = _
rs.Fields(intCol).NAME
'Debug.Print rs.Fields(intCol).NAME
Next
'Move data from the local recordset to Excell
xlApp.Range("A2").CopyFromRecordset rs
strFileName = xlApp.GetSaveAsFilename( _
"ExcelOutput", _
fileFilter:="MS Excel Files (*.xls), *.xls")
If Len(strFileName) > 0 Then
xlApp.ActiveWorkbook.SaveAs _
Filename:=strFileName
MsgBox "File save complete!", vbInformation
Else
MsgBox "File save aborted by user!", vbCritical
xlApp.ActiveWorkbook.Close False
End If
xlApp.Quit
Set xlApp = Nothing
Set rs = Nothing
End If
ExitHere:
DoCmd.Hourglass False
Exit Sub
HandleErrors:
MsgBox Err.Description & " " & Err.Number
DoCmd.Hourglass False
Resume ExitHere
End Sub
xlApp.Range("A2").CopyFromRecordset (rs)
It tells me that the object is not automatable?
Thanks
Rusty
PS: here is all of the code
Public Sub ExportToExcel(strSQL As String)
On Error GoTo HandleErrors
Dim response As String
response = _
MsgBox("This action may take several minutes." & _
vbCrLf & "Do you wish to continue...?", _
vbQuestion + vbOKCancel)
If response = vbOK Then
DoCmd.Hourglass True
Dim rs As DAO.Recordset
Dim xlApp As New Excel.Application
Dim intCol As Integer
Dim strFileName As String
Set rs = CurrentDb.OpenRecordset(strSQL)
Set xlApp = Excel.Application
xlApp.Workbooks.Add
'Add header row to spreadsheet
For intCol = 0 To rs.Fields.Count - 1
xlApp.Cells(1, intCol + 1).Value = _
rs.Fields(intCol).NAME
'Debug.Print rs.Fields(intCol).NAME
Next
'Move data from the local recordset to Excell
xlApp.Range("A2").CopyFromRecordset rs
strFileName = xlApp.GetSaveAsFilename( _
"ExcelOutput", _
fileFilter:="MS Excel Files (*.xls), *.xls")
If Len(strFileName) > 0 Then
xlApp.ActiveWorkbook.SaveAs _
Filename:=strFileName
MsgBox "File save complete!", vbInformation
Else
MsgBox "File save aborted by user!", vbCritical
xlApp.ActiveWorkbook.Close False
End If
xlApp.Quit
Set xlApp = Nothing
Set rs = Nothing
End If
ExitHere:
DoCmd.Hourglass False
Exit Sub
HandleErrors:
MsgBox Err.Description & " " & Err.Number
DoCmd.Hourglass False
Resume ExitHere
End Sub