Transfer data from a recordset to a worksheet (ADO)
If you don’t want to use the CopyFromRecordset method (Excel 2000 or later) you can use the procedure below to transfer data from a recordset to a worksheet. After you have connected to a database and retrieved data into a recordset variable you can use the procedure RS2WS to transfer the contents to a worksheet, including the recordset column headings:
' call the procedure like this:
' RS2WS rs, Range("A3") ' rs is an ADO recordset variable
Sub RS2WS(rs As ADODB.Recordset, TargetCell As Range)
Dim f As Integer, r As Long, c As Long
If rs Is Nothing Then Exit Sub
If rs.State <> adStateOpen Then Exit Sub
If TargetCell Is Nothing Then Exit Sub
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.StatusBar = "Writing data from recordset..."
End With
With TargetCell.Cells(1, 1)
r = .Row
c = .Column
End With
With TargetCell.Parent
.Range(.Cells(r, c), .Cells(.Rows.Count, c + rs.Fields.Count - 1)).Clear
' clear existing contents
' write column headers
For f = 0 To rs.Fields.Count - 1
On Error Resume Next
.Cells(r, c + f).Formula = rs.Fields(f).Name
On Error GoTo 0
Next f
' write records
On Error Resume Next
rs.MoveFirst
On Error GoTo 0
Do While Not rs.EOF
r = r + 1
For f = 0 To rs.Fields.Count - 1
On Error Resume Next
.Cells(r, c + f).Formula = rs.Fields(f).Value
On Error GoTo 0
Next f
rs.MoveNext
Loop
.Rows(TargetCell.Cells(1, 1).Row).Font.Bold = True
.Columns("A:IV").AutoFit
End With
With Application
.StatusBar = False
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
The macro example assumes that your VBA project has added a reference to the ADO object library. You can do this from within the VBE by selecting the menu Tools, References… and selecting the Microsoft ActiveX Data Objects x.x Object Library.
Erlandsen Data Consulting