hi,
I have the following code in a module:
Public Function ExportToExcel(TableName As String, FilePathname As String, _
Optional SheetName As String) As Boolean
Dim oRS As Object, oExcelApp As Object, lngFieldCounter As Long
Dim blnFileExists As Boolean, blnExcelRunning As Boolean, oTargetSheet As Object
On Error GoTo errHandler
'Firstly, open the recordset. The TableName argument can be either a table name or
'a valid SQL statement.
Set oRS = CreateObject("DAO.Recordset")
oRS.Open TableName, CurrentDb.Connection, 0, 1
'Get an instance of Excel. Use a running instance if one exists or create one if not.
On Error Resume Next
Set oExcelApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
blnExcelRunning = False
Set oExcelApp = CreateObject("Excel.Application")
Else
blnExcelRunning = True
End If
On Error GoTo errHandler
'Now see if the specified file exists or create it if not.
If Dir(FilePathname) <> "" Then
blnFileExists = True
oExcelApp.Workbooks.Open Filename:=FilePathname
Else
oExcelApp.Workbooks.Add
End If
'Get a reference to the sheet we're going to dump the data into. If it already exists
'then use that, otherwise add a sheet and name it.
If IsEmpty(SheetName) = False Then
On Error Resume Next
Set oTargetSheet = oExcelApp.ActiveWorkbook.Sheets(SheetName)
If Err.Number <> 0 Then
Set oTargetSheet = oExcelApp.ActiveWorkbook.Sheets.Add
oTargetSheet.Name = SheetName
End If
Else
Set oTargetSheet = oExcelApp.ActiveWorkbook.Sheets.Add
End If
On Error GoTo errHandler
'This loop will place the recordset field names into row 1 of the worksheet
For lngFieldCounter = 1 To oRS.Fields.Count
oTargetSheet.Cells(1, lngFieldCounter) = oRS.Fields(lngFieldCounter - 1).Name
Next lngFieldCounter
oTargetSheet.Range("A2").CopyFromRecordset oRS
oRS.Close
'Now save the Excel workbook and clean up
If blnFileExists Then
oExcelApp.ActiveWorkbook.Save
Else
oExcelApp.ActiveWorkbook.SaveAs Filename:=FilePathname
End If
oExcelApp.ActiveWorkbook.Close
If Not blnExcelRunning Then
oExcelApp.Quit
Set oExcelApp = Nothing
End If
Set oRS = Nothing
ExportToExcel = True
Exit Function
errHandler:
ExportToExcel = False
End Function
------------
I use the following to call the function:
Sub ExportCMStatsToExcelSheet_Click()
ExportToExcel("tblCMCode", "C:\CMCodeStats.xls", "CMCodeStats") As Boolean
End Sub
When I compile it, I am getting a "Statement Invalid Outside Type Block".
Does anyone know how to fix this? Please?
Thank you in advance...
I have the following code in a module:
Public Function ExportToExcel(TableName As String, FilePathname As String, _
Optional SheetName As String) As Boolean
Dim oRS As Object, oExcelApp As Object, lngFieldCounter As Long
Dim blnFileExists As Boolean, blnExcelRunning As Boolean, oTargetSheet As Object
On Error GoTo errHandler
'Firstly, open the recordset. The TableName argument can be either a table name or
'a valid SQL statement.
Set oRS = CreateObject("DAO.Recordset")
oRS.Open TableName, CurrentDb.Connection, 0, 1
'Get an instance of Excel. Use a running instance if one exists or create one if not.
On Error Resume Next
Set oExcelApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
blnExcelRunning = False
Set oExcelApp = CreateObject("Excel.Application")
Else
blnExcelRunning = True
End If
On Error GoTo errHandler
'Now see if the specified file exists or create it if not.
If Dir(FilePathname) <> "" Then
blnFileExists = True
oExcelApp.Workbooks.Open Filename:=FilePathname
Else
oExcelApp.Workbooks.Add
End If
'Get a reference to the sheet we're going to dump the data into. If it already exists
'then use that, otherwise add a sheet and name it.
If IsEmpty(SheetName) = False Then
On Error Resume Next
Set oTargetSheet = oExcelApp.ActiveWorkbook.Sheets(SheetName)
If Err.Number <> 0 Then
Set oTargetSheet = oExcelApp.ActiveWorkbook.Sheets.Add
oTargetSheet.Name = SheetName
End If
Else
Set oTargetSheet = oExcelApp.ActiveWorkbook.Sheets.Add
End If
On Error GoTo errHandler
'This loop will place the recordset field names into row 1 of the worksheet
For lngFieldCounter = 1 To oRS.Fields.Count
oTargetSheet.Cells(1, lngFieldCounter) = oRS.Fields(lngFieldCounter - 1).Name
Next lngFieldCounter
oTargetSheet.Range("A2").CopyFromRecordset oRS
oRS.Close
'Now save the Excel workbook and clean up
If blnFileExists Then
oExcelApp.ActiveWorkbook.Save
Else
oExcelApp.ActiveWorkbook.SaveAs Filename:=FilePathname
End If
oExcelApp.ActiveWorkbook.Close
If Not blnExcelRunning Then
oExcelApp.Quit
Set oExcelApp = Nothing
End If
Set oRS = Nothing
ExportToExcel = True
Exit Function
errHandler:
ExportToExcel = False
End Function
------------
I use the following to call the function:
Sub ExportCMStatsToExcelSheet_Click()
ExportToExcel("tblCMCode", "C:\CMCodeStats.xls", "CMCodeStats") As Boolean
End Sub
When I compile it, I am getting a "Statement Invalid Outside Type Block".
Does anyone know how to fix this? Please?
Thank you in advance...