Private Type ExlCellrow As Long
col As Long
End Type

Private Sub CopyRecords(rs As Recordset, ws As Worksheet, _
StartingCell As ExlCell)

Dim SomeArray() As Variant
Dim row As Long, col As Long
Dim fd As Field

' You might want to check if rs is not empty
rs.MoveLast ReDim SomeArray(rs.RecordCount + 1, rs.Fields.Count)

' Copy column headers to array
col = 0
For Each fd In rs.Fields
SomeArray(0, col) = fd.Name
col = col + 1
Next

' Copy rs to some array
rs.MoveFirst
For row = 1 To rs.RecordCount - 1
For col = 0 To rs.Fields.Count - 1
SomeArray(row, col) = rs.Fields(col).Value

' Excel will be offended if you try setting one ' of its cells to a NULL
If IsNull(SomeArray(row, col)) Then _
SomeArray(row, col) = "" Next rs.MoveNext
Next

' The range should have the same number of
' rows and cols as in the recordset
ws.Range(ws.Cells(StartingCell.row, StartingCell.col),
_ ws.Cells(StartingCell.row + rs.RecordCount + 1,
_ StartingCell.col + rs.Fields.Count)).Value = SomeArray

End Sub

Sub Form_Load()
Label1.AutoSize = True
Label1.Caption = "Ready"
Label1.Refresh
End Sub

Sub Command1_Click()
Dim oExcel as Object
Dim objExlSht As Object

' OLE automation object
Dim stCell As ExlCell
Dim db As Database

' Database object
Dim Sn As Recordset

' Recordset to hold records
MousePointer = vbHourglass

' Change mousepointer
Label1.Caption = "Creating Excel Object"
Label1.Refresh

Set oExcel = CreateObject("Excel.Application")
oExcel.WorkBooks.Add
Set objExlSht = oExcel.ActiveWorkbook.Sheets(1)

' Open the database:
Label1.Caption = "Opening the database"
Label1.Refresh
Set db = OpenDatabase("BIBLIO.MDB")

' Set up Field names as Column names:
Label1.Caption = "Creating SnapShot"
Label1.Refresh

Set Sn = db.OpenRecordset("Titles", dbOpenSnapshot)

' Start fill range at A1
stCell.row = 1
stCell.col = 1

' Place the fields across the top of the spreadsheet:
Label1.Caption = "Adding field names to Spreadsheet"
Label1.Refresh CopyRecords Sn, objExlSht, stCell

' Save the spreadsheet:
Label1.Caption = "Saving Spreadsheet"
Label1.Refresh

objExlSht.SaveAs "C:\TITLES.XLS"

' Quit the excel object - removes Excel from memory!
Label1.Caption = "Quitting Excel"
Label1.Refresh objExlSht.Application.Quit

' Clean up:
Label1.Caption = "Cleaning up"
Label1.Refresh
Set objExlSht = Nothing

' Remove object variable.
Set oExcel = Nothing

' Remove object variable.
Set Sn = Nothing

' Remove snapshot
object. Set db = Nothing

' Remove database object.
MousePointer = vbDefault

' Restore mouse pointer.
Label1.Caption = "Ready"
Label1.Refresh

End Sub