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

robault picture robault · Mar 20, 2010 · Viewed 34.2k times · Source

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)

Answer

robault picture robault · Mar 21, 2010

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