Mega Code Archive
Copying Records to an Excel Spreadsheet
<![CDATA[
Option Compare Database
Option Explicit
' be sure to select Microsoft Excel Object Library in the References dialog box
Public myExcel As Excel.Application
Sub CopyToExcel()
Dim conn As ADODB.Connection
Dim myRecordset As ADODB.Recordset
Dim wbk As Excel.Workbook
Dim myWorksheet As Excel.Worksheet
Dim StartRange As Excel.Range
Dim strConn As String
Dim i As Integer
Dim f As Variant
On Error GoTo ErrorHandler
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"
Set conn = New ADODB.Connection
Set myRecordset = New ADODB.Recordset
With myRecordset
.Open "Employees", strConn, _
adOpenKeyset, adLockOptimistic
End With
Set myExcel = New Excel.Application
Set wbk = myExcel.Workbooks.Add
Set myWorksheet = wbk.ActiveSheet
myExcel.Visible = True
i = 1
With myRecordset
For Each f In .Fields
With myWorksheet
.Cells(1, i).Value = f.Name
i = i + 1
End With
Next
End With
Set StartRange = myWorksheet.Cells(2, 1)
StartRange.CopyFromrecordset myRecordset
myRecordset.Close
Set myRecordset = Nothing
myWorksheet.Columns.AutoFit
wbk.Close SaveChanges:=True, _
FileName:="C:\ExcelFile.xls"
myExcel.Quit
Set conn = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbCritical, _
"Automation Error"
Set myExcel = Nothing
Exit Sub
End Sub
]]>