HOWTO: Convert a Database Table into an Excel Spreadsheet

• Microsoft Visual Basic Professional and Enterprise Editions for Windows, versions 4.0, 5.0
• Microsoft Excel for Windows, version 5.0
• Microsoft Excel for Windows 95, versions 7.0, 7.0a
• Microsoft Excel 97 for Windows

SUMMARY

This article contains a code example that demonstrates how to convert a database table into an Excel spreadsheet by using data access objects and OLE automation.

MORE INFORMATION

The program below demonstrates how easy it is to create a flexible and powerful program by integrating OLE automation with the data access objects in Visual Basic for Windows. Specifically, the program provides a method for converting a table that exists in a Microsoft Access database into a Microsoft Excel version 5.0 and above spreadsheet.

To do this, you'll need an Excel Spreadsheet object to receive the data from the table. This example uses OLE automation, so you'll need Excel version 5.0 or above. The program creates a Recordset object of type snapshot from the table you want to convert. The example uses the Titles table from the BIBLIO.MDB database: the sample database that comes with Visual Basic versions 4.0 and 5.0. After creating the snapshot, the program uses a user-defined CopyFromRecordset method to fill a variant array from the Recordset and uses this array to relay rows to Excel.

Steps to Create Example Program

The following steps are for the Visual Basic 4.0 IDE:

1. Create a new project in Visual Basic. Form1 is created by default.

2. Add a CommandButton (Command1) and label (Label1) to Form1.

3. Select References from the Tools menu. When the dialog box appears, select the "Microsoft Excel Object Library" and "Microsoft DAO Object Library" from the list of Available References. Click OK.

4. Place the following code in the General Declarations section of the form:

         ' 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 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
   
   

5. Press the F5 key to run the program. When you click the CommandButton, the data in the Titles table will be imported into an Excel spreadsheet. The label will update you on its progress.