ADO Recordset to Excel
Exports an ADO recordset to Microsoft Excel.
Original Author: Frank Ramos
Inputs
ADO Recordset
Assumptions
When done Excel is left open for user interact. Remember to reference Microsoft Excel Object and ActiveX Data Object Libraries in your Project.
Code
Public 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
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.