|
概要
您可以通过自动运行 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
这篇文章中的信息适用于:
|
• |
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 |
（Alex 转自MSDN）
|
