如何通过自动化将数据从 ADO 记录集传输到 Excel

项目
06/20/2023
适用于:

Excel 2007, Excel 2003, Excel 2002, Excel 2000, Excel 97

摘要

可以通过自动化 Excel 将 ADO 记录集的内容传输到 Microsoft Excel 工作表。可以使用的方法取决于自动执行的 Excel 版本。 Excel 97、Excel 2000 和 Excel 2002 具有 CopyFromRecordset 方法，可用于将记录集传输到区域。 Excel 2000 和 2002 中的 CopyFromRecordset 可用于复制 DAO 或 ADO 记录集。但是，Excel 97 中的 CopyFromRecordset 仅支持 DAO 记录集。若要将 ADO 记录集传输到 Excel 97，可以从记录集创建一个数组，然后使用该数组的内容填充区域。

本文讨论这两种方法。提供的示例代码演示了如何将 ADO 记录集传输到 Excel 97、Excel 2000、Excel 2002、Excel 2003 或 Excel 2007。

更多信息

下面提供的代码示例演示如何使用 Microsoft Visual Basic 中的自动化将 ADO 记录集复制到 Microsoft Excel 工作表。代码首先检查 Excel 的版本。如果检测到 Excel 2000 或 2002，则会使用 CopyFromRecordset 方法，因为它效率高，需要更少的代码。但是，如果检测到 Excel 97 或更早版本，则会首先使用 ADO 记录集对象的 GetRows 方法将记录集复制到数组。然后转置数组，以便记录在第一维度 (行) ，字段位于列) 的第二维 (中。然后，通过将数组分配给一系列单元格，将数组复制到 Excel 工作表。 (该数组在一个步骤中复制，而不是循环访问工作表中的每个单元格。)

代码示例使用 Microsoft Office 随附的 Northwind 示例数据库。如果在安装 Microsoft Office 时选择了默认文件夹，则数据库位于：

\Program Files\Microsoft Office\Office\Samples\Northwind.mdb

如果 Northwind 数据库位于计算机上另一个文件夹中，则需要在下面提供的代码中编辑数据库的路径。

如果系统上未安装 Northwind 数据库，则可以使用 Microsoft Office 安装程序的“添加/删除”选项来安装示例数据库。

注意安装 2007 Microsoft Office 时未安装 Northwind 数据库。若要获取 Northwind 2007，请访问以下 Microsoft 网站：

Office 模板 & 主题

创建示例的步骤

启动 Visual Basic 并创建新的标准 EXE 项目。默认情况下会创建 Form1。
将 CommandButton 添加到 Form1。
单击“项目”菜单中的“引用”。添加对 Microsoft ActiveX 数据对象 2.1 库的引用。

将以下代码粘贴到 Form1 的代码部分：

Private Sub Command1_Click()
    Dim cnt As New ADODB.Connection
    Dim rst As New ADODB.Recordset

Dim xlApp As Object
    Dim xlWb As Object
    Dim xlWs As Object

Dim recArray As Variant

Dim strDB As String
    Dim fldCount As Integer
    Dim recCount As Long
    Dim iCol As Integer
    Dim iRow As Integer

' Set the string to the path of your Northwind database
    strDB ="c:\program files\Microsoft office\office11\samples\Northwind.mdb"

' Open connection to the database
    cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & strDB & ";"

''When using the Access 2007 Northwind database
    ''comment the previous code and uncomment the following code.
    'cnt.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    '    "Data Source=" & strDB & ";"

' Open recordset based on Orders table
    rst.Open "Select * From Orders", cnt

' Create an instance of Excel and add a workbook
    Set xlApp = CreateObject("Excel.Application")
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets("Sheet1")

' Display Excel and give user control of Excel's lifetime
    xlApp.Visible = True
    xlApp.UserControl = True

' Copy field names to the first row of the worksheet
    fldCount = rst.Fields.Count
    For iCol = 1 To fldCount
        xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
    Next

' Check version of Excel
    If Val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then
        'EXCEL 2000,2002,2003, or 2007: Use CopyFromRecordset

' Copy the recordset to the worksheet, starting in cell A2
        xlWs.Cells(2, 1).CopyFromRecordset rst
        'Note: CopyFromRecordset will fail if the recordset
        'contains an OLE object field or array data such
        'as hierarchical recordsets

Else
        'EXCEL 97 or earlier: Use GetRows then copy array to Excel

' Copy recordset to an array
        recArray = rst.GetRows
        'Note: GetRows returns a 0-based array where the first
        'dimension contains fields and the second dimension
        'contains records. We will transpose this array so that
        'the first dimension contains records, allowing the
        'data to appears properly when copied to Excel

' Determine number of records

recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array

' Check the array for contents that are not valid when
        ' copying the array to an Excel worksheet
        For iCol = 0 To fldCount - 1
            For iRow = 0 To recCount - 1
                ' Take care of Date fields
                If IsDate(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = Format(recArray(iCol, iRow))
                ' Take care of OLE object fields or array fields
                ElseIf IsArray(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = "Array Field"
                End If
            Next iRow 'next record
        Next iCol 'next field

' Transpose and Copy the array to the worksheet,
        ' starting in cell A2
        xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
            TransposeDim(recArray)
    End If

' Auto-fit the column widths and row heights
    xlApp.Selection.CurrentRegion.Columns.AutoFit
    xlApp.Selection.CurrentRegion.Rows.AutoFit

' Close ADO objects
    rst.Close
    cnt.Close
    Set rst = Nothing
    Set cnt = Nothing

' Release Excel references
    Set xlWs = Nothing
    Set xlWb = Nothing

Set xlApp = Nothing

End Sub

Function TransposeDim(v As Variant) As Variant
' Custom Function to Transpose a 0-based array (v)

Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
    Dim tempArray As Variant

Xupper = UBound(v, 2)
    Yupper = UBound(v, 1)

ReDim tempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            tempArray(X, Y) = v(Y, X)
        Next Y
    Next X

TransposeDim = tempArray

End Function

按 F5 键运行项目。将显示 Form1。
单击 Form1 上的 CommandButton，并注意“订单”表的内容显示在 Excel 中的新工作簿中。

使用 CopyFromRecordset

为了提高效率和性能，CopyFromRecordset 是首选方法。由于 Excel 97 仅支持具有 CopyFromRecordset 的 DAO 记录集，因此，如果尝试使用 Excel 97 将 ADO 记录集传递到 CopyFromRecordset，则会收到以下错误：

运行时错误 430：类不支持自动化或不支持预期接口。在代码示例中，可以通过检查 Excel 的版本来避免此错误，这样就不会对 97 版本使用 CopyFromRecordset。

注意使用 CopyFromRecordset 时，应注意使用的 ADO 或 DAO 记录集不能包含 OLE 对象字段或数组数据，例如分层记录集。如果在记录集中包含任一类型的字段，则 CopyFromRecordset 方法将失败并出现以下错误：

运行时错误 -2147467259：对象范围的方法 CopyFromRecordset 失败。

使用 GetRows

如果检测到 Excel 97，请使用 ADO 记录集的 GetRows 方法将记录集复制到数组中。如果将 GetRows 返回的数组分配到工作表中的一系列单元格，则数据将跨列而不是下行。例如，如果记录集有两个字段和 10 行，则该数组将显示为两行和 10 列。因此，在将数组分配到单元格区域之前，需要使用 TransposeDim () 函数转置数组。将数组分配到单元格区域时，需要注意一些限制：

将数组分配到 Excel Range 对象时，以下限制适用：

该数组不能包含 OLE 对象字段或数组数据，例如分层记录集。请注意，代码示例检查此条件并显示“数组字段”，使用户知道该字段不能显示在 Excel 中。
该数组不能包含日期在 1900 年之前的日期字段。 (请参阅 Microsoft 知识库文章链接的“引用”部分。) 请注意，代码示例将日期字段格式化为变体字符串以避免此潜在问题。

请注意，在将数组复制到 Excel 工作表之前，使用 TransposeDim () 函数转置数组。通过修改示例代码将数组分配给单元格，可以使用 Excel 的 Transpose 函数，而不是创建自己的函数来转置数组，如下所示：

   xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
      xlApp.WorksheetFunction.Transpose(recArray)

如果决定使用 Excel 的 Transpose 方法而不是 TransposeDim () 函数来转置数组，则应注意 Transpose 方法的以下限制：

数组不能包含大于 255 个字符的元素。
数组不能包含 Null 值。
数组中的元素数不能超过 5461。

如果将数组复制到 Excel 工作表时未考虑上述限制，则可能会发生以下运行时错误之一：

运行时错误 13：类型不匹配

运行时错误 5：过程无效

调用或参数运行时错误 1004：应用程序定义或对象定义错误

参考

有关将数组传递到各种版本 Excel 的限制的其他信息，请单击以下文章编号，查看 Microsoft 知识库中的文章：

177991 XL：使用自动化将数组传递到 Excel 的限制

247412 信息：将数据从 Visual Basic 传输到 Excel 的方法

如何通过自动化将数据从 ADO 记录集传输到 Excel

摘要

更多信息

创建示例的步骤

使用 CopyFromRecordset

使用 GetRows

参考

其他资源