excelvbaadodbrecordset

VBA - Create ADODB.Recordset from the contents of a spreadsheet


I am working on an Excel application that queries a SQL database. The queries can take a long time to run (20-40 min). If I've miss-coded something it can take a long time to error or reach a break point. I can save the results to a sheet fine, it's when I am working with the record sets that things can blow up.

Is there a way to load the data into a ADODB.Recordset when I'm debugging to skip querying the database (after the first time)?

Would I use something like this?

Query Excel worksheet in MS-Access VBA (using ADODB recordset)


Solution

  • I had to install the MDAC to get the msado15.dll and once I had it I added a reference to it from (on Win7 64bit):

    C:\Program Files (x86)\Common Files\System\ado\msado15.dll

    Then I created a function to return an ADODB.Recordset object by passing in a sheet name that exists in the currently active workbook. Here's the code for any others if they need it, including a Test() Sub to see if it works:

    Public Function RecordSetFromSheet(sheetName As String)
    
    Dim rst As New ADODB.Recordset
    Dim cnx As New ADODB.Connection
    Dim cmd As New ADODB.Command
    
        'setup the connection
        '[HDR=Yes] means the Field names are in the first row
        With cnx
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .ConnectionString = "Data Source='" & ThisWorkbook.FullName & "'; " & "Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
            .Open
        End With
        
        'setup the command
        Set cmd.ActiveConnection = cnx
        cmd.CommandType = adCmdText
        cmd.CommandText = "SELECT * FROM [" & sheetName & "$]"
        rst.CursorLocation = adUseClient
        rst.CursorType = adOpenDynamic
        rst.LockType = adLockOptimistic
        
        'open the connection
        rst.Open cmd
        
        'disconnect the recordset
        Set rst.ActiveConnection = Nothing
        
        'cleanup
        If CBool(cmd.State And adStateOpen) = True Then
            Set cmd = Nothing
        End If
         
        If CBool(cnx.State And adStateOpen) = True Then cnx.Close
        Set cnx = Nothing
        
        '"return" the recordset object
        Set RecordSetFromSheet = rst
    
    End Function
    
    Public Sub Test()
    
    Dim rstData As ADODB.Recordset
    Set rstData = RecordSetFromSheet("Sheet1")
    
    Sheets("Sheet2").Range("A1").CopyFromRecordset rstData
    
    End Sub
    

    The Sheet1 data:
    Field1 Field2 Field3
    Red A 1
    Blue B 2
    Green C 3

    What should be copied to Sheet2:
    Red A 1
    Blue B 2
    Green C 3

    This is saving me a HUGE amount of time from querying against SQL every time I want to make a change and test it out...

    --Robert