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

Question

我正在开发一个查询 SQL 数据库的 Excel 应用程序。查询可能需要很长时间才能运行（20-40 分钟）。如果我错误编码了某些内容，可能需要很长时间才能出错或达到断点。我可以将结果保存到一张纸上，但当我处理记录集时，事情可能会崩溃。

当我调试以跳过查询数据库（第一次之后）时，有没有办法将数据加载到 ADODB.Recordset 中？

我会用这样的东西吗？

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

Answer 1

我必须安装 MDAC 才能获取 msado15.dll，一旦获得它，我就添加了对它的引用（在 Win7 64 位上）：

C:\Program Files (x86)\Common Files\System\ado\msado15.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 数据：
字段 1 字段 2 字段 3
红A 1
蓝色B 2
绿色 C 3

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

每次我想要进行更改并测试它时，这都为我节省了大量的 SQL 查询时间...--

Robert

Answer 2

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

Answer 3

从 Range 获取 Recordset 的另一种方法是从目标 Range 创建 XMLDocument 并打开使用 Range.Value() 属性从该文档获取 Recordset。

' 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