你目前正处于脱机状态,正在等待 Internet 重新连接

HOWTO:使用“自动化”功能将数据从 ADO 记录集传输到 Excel

针对 Office 2003 的支持已终止

Microsoft 已于 2014 年 4 月 8 日终止了针对 Office 2003 的支持。该更改已影响到您的软件更新和安全选项。 了解这一措施对于您的含义以及如何继续保持受保护状态。

概要
您可以通过自动运行 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。
更多信息
下面提供的代码示例显示了如何使用 Microsoft Visual Basic 的自动化功能将 ADO 记录集复制到 Microsoft Excel 工作表中。该代码首先检查 Excel 版本。如果检测到 Excel 2000 或 2002,将会使用 CopyFromRecordset 方法,因为它较为高效而且需要较少的代码。不过,如果检测到 Excel 97 或更低版本,将首先使用 ADO 记录集对象的 GetRows 方法将记录集复制到一个数组。然后将转置该数组,以便这些记录位于第一维度(在行中),字段位于第二维度(在列中)。然后,通过将该数组分配到单元格区域将此数组复制到 Excel 工作表中。(该数组在一个步骤中复制,而不是循环工作表中的每个单元格。)

该代码示例使用 Microsoft Office 中包括的罗斯文示例数据库。如果在安装 Microsoft Office 时选择了默认文件夹,则该数据库位于:

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

如果罗斯文数据库位于计算机上的其他文件夹,您需要在下面提供的代码中编辑数据库的路径。

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

创建示例的步骤

  1. 启动 Visual Basic,新建一个标准 EXE 项目。默认情况下会创建 Form1。
  2. CommandButton 添加到 Form1 中。
  3. 单击项目菜单中的引用。向 Microsoft ActiveX 数据对象 2.1 库中添加一个引用。
  4. 将以下代码粘贴到 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 & ";"            ' 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 or 2002: 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 = NothingEnd SubFunction 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 = tempArrayEnd Function					
  5. 按 F5 键运行该项目。此时出现 Form1。
  6. 单击 Form1 上的 CommandButton,并注意订单表中的内容将显示在 Excel 中的新工作簿中。
使用 CopyFromRecordset

CopyFromRecordset 是提高效率和性能的首选方法。由于 Excel 97 的 CopyFromRecordset 仅支持 DAO 记录集,如果您尝试将 ADO 记录集传递到 Excel 97 中的 CopyFromRecordset。将会收到下面的错误:
Run-time error 430:
Class does not support Automation or does not support expected interface.
在此代码示例中,您可以通过检查 Excel 的版本,不使用 97 版本的 CopyFromRecordset 来避免此错误。

注意:在使用 CopyFromRecordset 时,需要知道您使用的 ADO 或 DAO 记录集不能包含 OLE 对象字段或数组数据,如分层记录集。如果记录集中包括任一类型的字段,CopyFromRecordset 方法将会失败,并显示下面的错误信息:
Run-time error -2147467259:
Method CopyFromRecordset of object Range failed.
使用 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 个字符的元素。
  • 数组不能包含空值。
  • 数组中的元素个数不能超过 5461 个。
在将数组复制到 Excel 工作表中时,如果没有考虑到这些限制,可能会出现下列运行时错误之一:
Run-time Error 13:Type Mismatch
Run-time Error 5:Invalid procedure call or argument
Run-time Error 1004:Application defined or object defined error
参考
有关将数组传递到各版本 Excel 的限制的其他信息,请单击下面的文章编号,以查看 Microsoft 知识库中的文章:
177991XL:Limitations of Passing Arrays to Excel Using Automation
有关其他信息,请单击下面的文章编号,以查看 Microsoft 知识库中相应的文章:
146406 XL:How to Retrieve a Table from Access into Excel Using DAO
215965 XL2000:12:00:00 AM Displayed for Dates Earlier Than 1900
243394 HOWTO:Use MFC to Copy a DAO Recordset to Excel with Automation
247412 INFO:将数据从 Visual Basic 传输到 Excel 的方法
Transpose Mismatch
属性

文章 ID:246335 - 上次审阅时间:04/26/2004 20:44:00 - 修订版本: 4.0

  • Microsoft Office Excel 2003
  • Microsoft Excel 2002 标准版
  • Microsoft Excel 2000 标准版
  • Microsoft Excel 97 标准版
  • Microsoft Visual Basic 5.0 专业版
  • Microsoft Visual Basic 6.0 专业版
  • Microsoft Visual Basic 5.0 企业版
  • Microsoft Visual Basic 6.0 企业版
  • Microsoft ActiveX Data Objects 2.0
  • Microsoft ActiveX Data Objects 2.1
  • Microsoft ActiveX Data Objects 2.5
  • kbhowto kbautomation KB246335
反馈