HOWTO: Convert a Database Table into an Excel Spreadsheet
ID: Q172058
|
The information in this article applies to:
-
Microsoft Visual Basic Professional and Enterprise Editions for Windows, versions 4.0, 5.0, 6.0
-
Microsoft Excel 2000
-
Microsoft Office 2000 Developer
-
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
- Create a new project in Visual Basic. Form1 is created by default.
- Add a CommandButton (Command1) and label (Label1) to Form1.
- Reference both the "Microsoft Excel Object Library" and the "Microsoft
DAO Object Library."
- 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
- 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.
Additional query words:
Excel CopyFromRecordSet
Keywords : kbinterop kbAutomation kbVBp kbVBp400 kbVBp500 kbVBp600 kbGrpDSO kbOffice2000 kbexcel2000
Version : WINDOWS:2000,4.0,5.0,6.0,97; :
Platform : WINDOWS
Issue type : kbhowto