ExcellToRSet

Sub ToExcel(Sn As Recordset, strCaption As String)
        Dim oExcel As Object
        Dim objExlSht As Object' OLE automation object
        Dim stCell As ExlCell
        DoEvents
        On Error Resume Next
        Set oExcel = GetObject(, "Excel.Application")
        'If Excel is not launched start it
        If Err = 429 Then
            Err = 0
            Set oExcel = CreateObject("Excel.Application")
            'Can't create object
            If Err = 429 Then
                MsgBox Err & ": " & Error, vbExclamation + vbOKOnly
                Exit Sub
            End If
        End If
        oExcel.Workbooks.Add
        oExcel.Worksheets("sheet1").Name = strCaption
        Set objExlSht = oExcel.ActiveWorkbook.Sheets(1)
        stCell.row = 1
        stCell.col = 1
        'Place the fields across the top of the spreadsheet:
        CopyRecords Sn, objExlSht, stCell
        'Give the user control
        oExcel.Visible = True
        oExcel.Interactive = True
        'Clean up:
        Set objExlSht = Nothing ' Remove object variable.
        Set oExcel = Nothing' Remove object variable.
        Set Sn = Nothing ' Remove snapshot object.
    End Sub

Inputs:
Sn - Recordset to copy
     strCaption - Name to assign to the created worksheet

'Assumes:
You must add a reference to the Excel 8.0 Object Library
and DAO Object Library for this code to work properly. 
This has been tested on dynaset type recordsets and 
Excel97 only. I assume it could be modified if needed to 
fit many other needs. This code is based on an MSKB 
article but has been modified to be useable in a wider 
array of situations.

'User defined type to help determine the

'starting cell in the range receiving the recordset

Private Type ExlCell
row 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 ToExcel(Sn As Recordset, strCaption As String)
Dim oExcel As Object
Dim objExlSht As Object' OLE automation object
Dim stCell As ExlCell
DoEvents
On Error Resume Next
Set oExcel = GetObject(, "Excel.Application")
'If Excel is not launched start it

If Err = 429 Then
Err = 0
Set oExcel = CreateObject("Excel.Application")
'Can't create object

If Err = 429 Then
MsgBox Err & ": " & Error, vbExclamation + vbOKOnly
Exit Sub
End If
End If
oExcel.Workbooks.Add
oExcel.Worksheets("sheet1").Name = strCaption
Set objExlSht = oExcel.ActiveWorkbook.Sheets(1)
stCell.row = 1
stCell.col = 1
'Place the fields across the top of the spreadsheet:

CopyRecords Sn, objExlSht, stCell
'Give the user control

oExcel.Visible = True
oExcel.Interactive = True
'Clean up:

Set objExlSht = Nothing ' Remove object variable.
Set oExcel = Nothing' Remove object variable.
Set Sn = Nothing ' Remove snapshot object.
End Sub

Inputs:
Sn - Recordset to copy
strCaption - Name to assign to the created worksheet

'Assumes:

You must add a reference to the Excel 8.0 Object Library
and DAO Object Library for this code to work properly.
This has been tested on dynaset type recordsets and
Excel97 only. I assume it could be modified if needed to
fit many other needs. This code is based on an MSKB
article but has been modified to be useable in a wider
array of situations.