PRB: Error Passing Recordset to Excel Using Automation From Visual Basic

RESOLUTION

1. Start Visual Basic. Form1 is created by default.
2. Add a command button to Form1.
3. Add a data control and set its properties as follows:

         DatabaseName       biblio.mdb
         RecordSource      Authors
   					

4. Add the following code to the General Declarations section of Form1:

         ' User defined type to help determine the
         ' starting cell in the range receiving the recordset
   
         Option Explicit
   
         Private Type ExlCell
            row As Long
            col As Long
         End Type
   
         Private Sub CopyRecords(rs As Recordset, ws As Object, _
           StartingCell As ExlCell)
            Dim SomeArray() As Variant
            Dim row As Long, col As Long
   
            ' You might want to check if rs is not empty
            ' before re-dimensioning the array
            rs.MoveLast
            ReDim SomeArray(rs.RecordCount - 1, rs.Fields.Count - 1)
   
            ' Copy rs to some array
            rs.MoveFirst
            For row = 0 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 - 1)).Value = SomeArray
         End Sub
   
         Private Sub Command1_Click()
            Dim stcell As ExlCell
            Dim objExlApp As Object
   
            ' Get an Excel app object reference
            On Error Resume Next
            Set objExlApp = GetObject(, "Excel.Application")
            ' If Excel is not launched start it
            If Err = 429 Then
               Err = 0
               Set objExlApp = CreateObject("Excel.Application")
               ' Can't create object
               If Err = 429 Then
                  MsgBox Err & ": " & Error
                  Exit Sub
               End If
            End If
            On Error GoTo 0
   
            ' Add a new Workbook
            objExlApp.Workbooks.Add
   
            ' Select the first sheet
            objExlApp.Worksheets("sheet1").Select
   
            ' Start fill range at A1
            stcell.row = 1
            stcell.col = 1
   
            ' Call CopyRecords procedure to populate sheet with array
            CopyRecords Data1.Recordset, objExlApp.ActiveSheet, stcell
   
            ' Show Excel and kill reference
            objExlApp.Visible = True
            objExlApp.Interactive = True
            Set objExlApp = Nothing
         End Sub
   					

5. Start the project and click the command button. Excel should start (if it is not already started) and fill the first sheet of a new workbook with the rows from the Authors table in the biblio.mdb database.