You need to add a reference to DAO to in your application to use the code suggested.
Open a module and click references, then find microsoft DAO and add the reference.
I'd probably use a different method though....
Ive pasted in two of my functions for you. One is a simple function to open a session of an External application, in this case Excel.
The other is a fairly generic routine that use the copyfrom recordset function to export the results of a recordset. You can specify weather you want to open the export in Excel once complete etc, or if you want to export fields names etc etc
To use them you can do something like this...
From the button on your form, obviously changing those bits you need to, run this bit of code....
call fexport(me.recordsetclone, "c:\", "Test.xls")
This will export whatever records you have on your form at the time. You can play around with the other parameters to show Excel etc if you want.
For this to work you still need to add a reference to DAO. Hope this helps
Function fExportToExcel(rsExport As DAO.Recordset, strFilePath As String, strFileName As String, _
Optional strSheetName As String = "Export", _
Optional blnCreateHeaders As Boolean = True, _
Optional blnShowExcel As Boolean = False, _
Optional blnCloseAfterExport As Boolean = True, _
Optional blnNewWorkbook As Boolean = True, _
Optional blnDispMsg As Boolean = True)
'============================================================
' Purpose: Exports contents of a recordset
' Programmer: Richard Jervis
' Date: 30/09/2002
'============================================================
On Error GoTo fExportToExcel_Err
Dim strErrMsg As String 'For Error Handling
Dim objExcel As Object
Dim objWorkbook As Object
Dim lngSheetCount As Long
Dim lngDeleteCount As Long
Dim lngFieldCount As Long
Dim blnSheetFound As Boolean
Dim varField As Variant
Set objExcel = fOpenApplication("Excel", blnShowExcel, True)
blnSheetFound = False
With objExcel.workbooks
.Application.displayalerts = False
If blnNewWorkbook = True Then
'Create new workbook
Set objWorkbook = .Add
Else
'Use an existing workbook
If Dir(strFilePath & strFileName) = strFileName Then
'File exists
Set objWorkbook = .Open(strFilePath & strFileName, False)
Else
'#### File does not exist ####
blnNewWorkbook = True
Set objWorkbook = .Add
End If
End If
End With
With objWorkbook
lngSheetCount = .sheets.Count
If blnNewWorkbook = True Then
'New workbook
If lngSheetCount > 1 Then
'If their is more than one, delete it.
For lngDeleteCount = lngSheetCount To 2
.sheets(lngDeleteCount).Delete
Next
Else
End If
.sheets(1).Name = strSheetName
Else
'Existing workbook
'Try to find worksheet
For lngSheetCount = 1 To .sheets.Count
If LCase(.sheets(lngSheetCount)) = LCase(strSheetName) Then
blnSheetFound = True
Exit For
End If
Next
If blnSheetFound = True Then
'Found sheet, do nothing
Else
'No sheet found lets create one
.sheets.Add after:=.sheets(.sheets.Count)
'Now we need to rename it
.sheets(.sheets.Count) = strSheetName
End If
End If
'Clear out the sheet
.sheets(strSheetName).cells(1, 1).clearcontents
If blnCreateHeaders = True Then
lngFieldCount = 1
For Each varField In rsExport.Fields
.sheets(strSheetName).cells(1, lngFieldCount).Value = varField.Name
lngFieldCount = lngFieldCount + 1
Next
.sheets(strSheetName).cells(2, 1).copyfromrecordset rsExport
Else
.sheets(strSheetName).cells(1, 1).copyfromrecordset rsExport
End If
.sheets(strSheetName).usedrange.entirecolumn.autofit
.Saveas strFilePath & strFileName
If blnCloseAfterExport = True Then
.Application.Quit
Else
If blnShowExcel = False Then
'Excel is not visible we must close it
.Application.Quit
Else
End If
End If
End With
If blnDispMsg = True Then
MsgBox "Excel file export created!", vbInformation
End If
fExportToExcel_Exit:
On Error Resume Next
objExcel.Application.displayalerts = True
Set objExcel = Nothing
Exit Function
fExportToExcel_Err:
Select Case Err
Case Else
'File is open
strErrMsg = vbNullString
strErrMsg = "There has been a problem exporting the blotter. " & vbCrLf & _
"This may be due to someone being in the file."
MsgBox strErrMsg, vbCritical, "Output Error!"
End Select
End Function
Function fOpenApplication(strApplication As String, Optional blnVisible As Boolean = False, _
Optional blnForceNewApp As Boolean = False) As Object
'============================================================
' Purpose: Opens an instance of a selected application
' Programmer: Richard Jervis
' Date: 05/02/02
'============================================================
On Error GoTo fOpenApplication_Err
Dim strErrMsg As String 'For Error Handling
Dim objApplication As Variant
On Error Resume Next
Set objApplication = GetObject(, strApplication & ".Application")
If Err.Number <> 0 Or blnForceNewApp = True Then
'Excel Not Open
Err.Clear
'Turn error handling back on
On Error GoTo fOpenApplication_Err
Set objApplication = CreateObject(strApplication & ".Application")
Else
On Error GoTo fOpenApplication_Err
End If
'Do we want to see the application?
If blnVisible = True Then
objApplication.Visible = True
End If
Set fOpenApplication = objApplication
fOpenApplication_Exit:
Set objApplication = Nothing
Exit Function
fOpenApplication_Err:
Select Case Err
Case Else
strErrMsg = strErrMsg & "Error #: " & Format$(Err.Number) & vbCrLf & vbCrLf
strErrMsg = strErrMsg & "Error Description: " & Err.Description & vbCrLf
MsgBox strErrMsg, vbInformation, "Error in fOpenApplication procedure"
Resume fOpenApplication_Exit
End Select
End Function
