by Frank Ramos (1 Submission)
Category: Databases/Data Access/DAO/ADO
Compatability: Visual Basic 5.0
Difficulty: Intermediate
Date Added: Wed 3rd February 2021
Rating: 
(20 Votes)
Exports an ADO recordset to Microsoft Excel.
Inputs
ADO Recordset
Assumes
When done Excel is left open for user interact. Remember to reference Microsoft Excel Object and ActiveX Data Object Libraries in your Project.
VBcodersPublic Sub Recordset2Excel(rstSource As ADODB.Recordset)
Dim xlsApp As Excel.Application
Dim xlsWBook As Excel.Workbook
Dim xlsWSheet As Excel.Worksheet
Dim i, j As Integer
' Get or Create Excel Object
On Error Resume Next
Set xlsApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlsApp = New Excel.Application
Err.Clear
End If
' Create WorkSheet
Set xlsWBook = xlsApp.Workbooks.Add
Set xlsWSheet = xlsWBook.ActiveSheet
' Export ColumnHeaders
For j = 0 To rstSource.Fields.Count
xlsWSheet.Cells(2, j + 1) = rstSource.Fields(j).Name
Next j
' Export Data
rstSource.MoveFirst
For i = 1 To rstSource.RecordCount
For j = 0 To rstSource.Fields.Count
xlsWSheet.Cells(i + 2, j + 1) = rstSource.Fields(j).Value
Next j
rstSource.MoveNext
Next i
rstSource.MoveFirst
' Autofit column headers
For i = 1 To rstSource.Fields.Count
xlsWSheet.Columns(i).AutoFit
Next i
' Move to first cell to unselect
xlsWSheet.Range("A1").Select
' Show Excel
xlsApp.Visible = True
Set xlsApp = Nothing
Set xlsWBook = Nothing
Set xlsWSheet = Nothing
End Sub
