HAL-PC Excel SIG VBA: CopyFromRecordset Example

A very fast means of taking an Access DAO recordset (it might work with ADO, too, I don't know) is to use the CopyFromRecordset method of an Excel Range Object.

This is unbelievably hard to find in MS Excel VBA help. I never use the right keywords to find it.

Thanks to Gordon Padwick (1996) Integrated Office Applications, p. 329. This book was my bible in regard to inter-application development.

Sub ExportFromProspectDB990630()
    Dim objAcc As Application
    Dim dbPros As Object
    Dim rsX1 As Object
    Dim rng1 As Range
    Dim sDBProspName As String
    Dim sQryName As String
    
    Dim oldStatusBar As Boolean
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    
    sDBProspName = Range("X1A1DatabasePath")
    
    sQryName = "X1A1qryProsCurrentEssent"
    sQryName = Range("X1A1QueryName")
    
    'Set dbPros = opendatabase(sDBProspName)
    
    'from Padwick 96: Integrated Office Applications, p. 329
    Dim appDB As Application
    'Set appDB = CreateObject("access.application")
    On Error GoTo NoDB
    Application.StatusBar = "Opening Database: " & sDBProspName
    Set dbPros = OpenDatabase(sDBProspName)
    
    Application.StatusBar = "Reading Recordset..."
    Set rsX1 = dbPros.OpenRecordset(sQryName)
    
    Application.StatusBar = "Cleaning Spreadsheet..."
    With ActiveWorkbook.Sheets("X1A1qry")
        Set rng1 = .Range("X1A1UL")
        On Error Resume Next
        .Range("X1A1Area").Select
        If Err = 0 Then
            Selection.Clear
        End If
        .Range("X1A1UL").Select
        Selection.CurrentRegion.Select
        Selection.Clear
    End With
    On Error GoTo 0
    
    
    Application.StatusBar = "Writing Recordset to Spreadsheet..."
    Dim vaTmp() As String
    ReDim vaTmp(rsX1.Fields.Count)
    Dim ix As Integer
    For ix = 0 To rsX1.Fields.Count - 1
       vaTmp(ix) = rsX1.Fields(ix).Name
    Next
    rng1.Resize(1, rsX1.Fields.Count) = vaTmp
    
    Set rng1 = rng1.Offset(1, 0)
    
    rng1.CopyFromRecordset rsX1     'This is the magic right here!!!!
    rng1.CurrentRegion.Select
    
    ActiveWorkbook.Names.Add "X1A1Area", RefersTo:=rng1.CurrentRegion.Address
    Range("X1A1QueryTime") = Now
    
    Application.StatusBar = False
    Application.DisplayStatusBar = oldStatusBar
    Exit Sub
    
NoDB:
    MsgBox "Database Path failed to open.   Check DatabasePath"
    
End Sub