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

文章翻译 文章翻译
文章编号: 246335 - 查看本文应用于的产品
展开全部 | 关闭全部

本文内容

概要

您可以通过自动运行 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 = 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
    
    					
  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 知识库中的文章:
177991 XL: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 的方法

属性

文章编号: 246335 - 最后修改: 2004年4月26日 - 修订: 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
Microsoft和/或其各供应商对于为任何目的而在本服务器上发布的文件及有关图形所含信息的适用性,不作任何声明。 所有该等文件及有关图形均"依样"提供,而不带任何性质的保证。Microsoft和/或其各供应商特此声明,对所有与该等信息有关的保证和条件不负任何责任,该等保证和条件包括关于适销性、符合特定用途、所有权和非侵权的所有默示保证和条件。在任何情况下,在由于使用或运行本服务器上的信息所引起的或与该等使用或运行有关的诉讼中,Microsoft和/或其各供应商就因丧失使用、数据或利润所导致的任何特别的、间接的、衍生性的损害或任何因使用而丧失所导致的之损害、数据或利润不负任何责任。

提供反馈

 

Contact us for more help

Contact us for more help
Connect with Answer Desk for expert help.
Get more support from smallbusiness.support.microsoft.com