VBA - 从电子表格的内容中创建ADODB.Recordset。

Question

我正在开发一个查询SQL数据库的Excel应用程序。查询可能需要很长的时间来运行（20-40分钟）。如果我错过了一些代码，可能需要很长时间才能出错或达到断点。我可以将结果保存到工作表中，但当我在处理记录集时，事情就会变得很糟糕。

有没有办法在我调试的时候把数据加载到ADODB.Recordset中跳过查询数据库（第一次查询后）？

我会用这样的方法吗？

在MS-Access VBA中查询Excel工作表(使用ADODB记录集)

Answer 1

我不得不安装MDAC以获得msado15.dll，一旦我有了它，我添加了一个参考（在Win7 64位）。

C:程序文件(x86)/通用文件/系统/msado/15.dll

然后我创建了一个函数，通过传递当前活动工作簿中存在的工作表名称来返回一个ADODB.Recordset对象。下面是代码，如果其他的人需要的话，包括一个Test()Sub来看看它是否有效。

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

Sheet1数据：Field1 Field2 Field3Red A 1Blue B 2Green C 3

应该复制到Sheet2的内容：红色A 1蓝色B 2绿色C 3。

这为我节省了大量的时间，每次我想做一个改变和测试时，都要对着SQL进行查询。

--Robert

Answer 2

最简单的是使用 rs.Save "filename" 和 rs.Open "filename" 来将客户端的记录集序列化到文件中。

Answer 3

另一种选择是将客户端记录集序列化到文件中。Recordset 从 Range 将是创造和 XMLDocument 从目标 Range 并打开 Recordset 从该文件中使用 Range.Value() 属性。

' 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

请确保为这两个属性设置一个引用 Microsoft ActiveX Data Objects 6.1 Library 和 Microsoft XML, v6.0 如果你想使用上面的例子。如果需要的话，你也可以把这个函数改为后期绑定。

调用示例

' Sample of using `RecordsetFromRange`
' @author Robert Todar <[email protected]>
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