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

Question

我正在开发一个查询 SQL 数据库的 Excel 应用程序。查询可能需要很长时间才能运行（20-40 分钟）。如果我遗漏了某些内容，则可能需要很长时间才能出错或达到断点。我可以很好地将结果保存到工作表中，当我使用记录集时，事情可能会爆炸。

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

我会使用这样的东西吗？

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

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 绿C 3

每次我想进行更改和测试时，我都可以从查询 SQL 中节省大量时间...

--罗伯特

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 <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