Private Sub ImportTable(ByVal Rs As ADODB.Recordset, ByVal worksheetName As String, Optional ByVal appendMode As Boolean = False, Optional ByVal PrintFieldHeader As Boolean = True)
'Date: 9 April, 2009
'Author: David Tsang
Dim ws As Worksheet
Dim rowStart As Double
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If worksheetName = "$" Then
Exit Sub
End If
Set ws = Worksheets(worksheetName)
If appendMode = False Then
ws.Cells.ClearContents
rowStart = 1
Else
rowStart = ws.UsedRange.Rows.Count + 1
End If
With ws
If PrintFieldHeader = True Then
For x = 1 To Rs.Fields.Count
.Cells(rowStart, x).Value = "'" & Rs.Fields(x - 1).Name
Next
rowStart = rowStart + 1
End If
With .Cells(rowStart, 1)
numberOfRows = .CopyFromRecordset(Rs)
End With
.Columns.AutoFit
End With
Do Until ws.UsedRange.Rows.Count >= Rs.RecordCount
DoEvents
Loop
Application.Calculation = xlCalculationAutomatic
End Sub
