Ok heres the code for ya...
There are 2 functions..
fExportToExcel - This creates an Excel export
fOpenApplication - This opens an instance of an application
To use copy and paste the 2 functions into your db.
Then create a recordset object that contains the data you wish to export.
The call the function and pass in the recordset plus your options...
fExportToExcel rsData, "C:\", "Bigdata.xls", "Big Data", true, false
Explanation of the options....
rsExport = Recordset object containing data to export
strFilePath = The path of the export
strFileName = The file name to export
strSheetName = the name of the sheet in created excel file
blnCreateHeaders = Export field names? True or false
blnShowExcel = Show Excel when exporting? True or false
blnCloseAfterExport = Close Excel after export? True or false
blnNewWorkbook = Is this a new workbook or adding to an existing? True or false
blnDispMsg = Display a message to confirm export?True or false
Hope this helps you!
### Code ###
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 file. " & 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
