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

Question

我正在开发一个Excel应用程序，用于查询SQL数据库。查询可能需要很长时间才能运行（20-40分钟）。如果我编写的代码有误，它可能需要很长时间才能出错或达到断点。我可以将结果保存到工作表中，但在使用记录集时可能会出现问题。

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

我应该使用这样的东西吗？ 在MS-Access VBA中查询Excel工作表（使用ADODB记录集）

- robault

---

这对我来说看起来不错，请注意连接字符串，如果您使用的是大于2003的版本。 - Fionnuala

感谢您的留言。虽然我的问题基本上要求是一个是/否回答，但我还希望能够得到一点代码或更明确的示例链接。这可能是我的过错。 :) - robault

Answer 1

我需要安装MDAC才能获取msado15.dll，一旦我有了它，我就从以下路径（在Win7 64位上）添加了对它的引用：

C:\Program Files (x86)\Common Files\System\ado\msado15.dll

然后我创建了一个函数，通过传递当前活动工作簿中存在的工作表名称来返回一个ADODB.Recordset对象。如果其他人需要这个代码，包括一个测试()子程序来查看它是否有效，请参考以下代码：

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

--罗伯特

- robault

---

表格数据没有按照我想要的方式对齐，看起来注释中的回车被删除了。希望它仍然有意义。 - robault

cmd.State 不是位掩码，只需使用 cmd.State = adStateOpen。 - wqw

Answer 2

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

- wqw

---

好的点子，可能会奏效，但我还没有尝试过。我能够在上面的VBA函数中使用解决方案。不过还是谢谢你的提示。这个方法也可能同样有效。 - robault

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 <[e-mail]>
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

- Robert Todar