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)

---

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

---

Easiest would be to use rs.Save "filename" and rs.Open "filename" to serialize client-side recordsets to files.

---

Another alternative to get a Recordset from a Range would be to create and XMLDocument from the target Range and open the Recordset from that document using the Range.Value() property.

' Creates XML document from the target range and then opens a recordset from the XML doc.
' @ref Microsoft ActiveX Data Objects 6.1 Library
' @ref Microsoft XML, v6.0
Public Function RecordsetFromRange(ByRef target As Range) As Recordset
        ' Create XML Document from the target range.
        Dim doc As MSXML2.DOMDocument
        Set doc = New MSXML2.DOMDocument
        doc.LoadXML target.Value(xlRangeValueMSPersistXML)

        ' Open the recordset from the XML Doc.
        Set RecordsetFromRange = New ADODB.Recordset
        RecordsetFromRange.Open doc
End Function

Make sure to set a reference to both Microsoft ActiveX Data Objects 6.1 Library and Microsoft XML, v6.0 if you want to use the example above. You could also change this function to late binding if so desired.

Example call

' Sample of using `RecordsetFromRange`
' @author Robert Todar <robert@roberttodar.com>
Private Sub testRecordsetFromRange()
    ' Test call to get rs from Range.
    Dim rs As Recordset
    Set rs = RecordsetFromRange(Range("A1").CurrentRegion)

    ' Loop all rows in the recordset
    rs.MoveFirst
    Do While Not rs.EOF And Not rs.BOF
        ' Sample if the fields `Name` and `ID` existed in the rs.
        ' Debug.Print rs.Fields("Name"), rs.Fields("ID")

        ' Move to the next row in the recordset
        rs.MoveNext
    Loop
End Sub