オートメーションを使用して ADO Recordset から 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 メソッドを使用して、レコードセットが配列にコピーされます。その後、レコードが最初のディメンション (行単位) に配置され、フィールドが 2 番目のディメンション (列内) に配置されるように配列が移置されます。次に、セル範囲に配列を割り当てることで、配列が Excel ワークシートにコピーされます。 (配列は、ワークシート内の各セルをループするのではなく、1 つの手順でコピーされます)。

このコードサンプルでは、Microsoft Office に含まれる Northwind サンプルデータベースを使用します。 Microsoft Office のインストール時に既定のフォルダーを選択した場合、データベースは次の場所にあります。

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

Northwind データベースがコンピューター上の別のフォルダーにある場合は、次に示すコードでデータベースのパスを編集する必要があります。

システムに Northwind データベースがインストールされていない場合は、Microsoft Office セットアップの [追加と削除] オプションを使用してサンプルデータベースをインストールできます。

メモ 2007 Microsoft Office をインストールしても、Northwind データベースはインストールされません。 Northwind 2007 を入手するには、次の Microsoft Web サイトを参照してください。

Office テンプレートの & テーマ

サンプルを作成する手順

Visual Basic を起動し、新しい Standard EXE プロジェクトを作成します。 Form1 は既定で作成されます。
Form1 に CommandButton を追加します。
[プロジェクト] メニューの [参照] をクリックします。 Microsoft ActiveX Data Objects 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 をクリックし、Orders テーブルの内容が Excel の新しいブックに表示されることに注意してください。

CopyFromRecordset の使用

効率とパフォーマンスを向上させるために、CopyFromRecordset が推奨される方法です。 Excel 97 では CopyFromRecordset を使用した DAO レコードセットのみがサポートされるため、Excel 97 で ADO レコードセットを CopyFromRecordset に渡そうとすると、次のエラーが表示されます。

実行時エラー 430: クラスは Automation をサポートしていないか、期待されるインターフェイスをサポートしていません。コードサンプルでは、97 バージョンに CopyFromRecordset を使用しないように Excel のバージョンを確認することで、このエラーを回避できます。

メモ CopyFromRecordset を使用する場合、使用する ADO または DAO レコードセットに OLE オブジェクトフィールドや階層レコードセットなどの配列データを含めることはできません。レコードセットにいずれかの型のフィールドを含める場合、CopyFromRecordset メソッドは次のエラーで失敗します。

実行時エラー -2147467259: オブジェクト範囲のメソッド CopyFromRecordset が失敗しました。

GetRows の使用

Excel 97 が検出された場合は、ADO レコードセットの GetRows メソッドを使用して、レコードセットを配列にコピーします。 GetRows によって返された配列をワークシート内のセル範囲に割り当てると、データは行の下ではなく列に渡ります。たとえば、レコードセットに 2 つのフィールドと 10 行がある場合、配列は 2 行と 10 列として表示されます。そのため、セル範囲に配列を割り当てる前に、TransposeDim() 関数を使用して配列を移調する必要があります。セルの範囲に配列を割り当てる場合は、次の点に注意する必要があります。

Excel Range オブジェクトに配列を割り当てる場合、次の制限事項が適用されます。

この配列には、OLE オブジェクトフィールドや階層レコードセットなどの配列データを含めることはできません。コードサンプルでは、この条件がチェックされ、Excel でフィールドを表示できないことにユーザーが認識されるように "配列フィールド" が表示されます。
配列には、1900 年より前の日付を持つ Date フィールドを含めることはできません。 (Microsoft サポート技術情報の記事リンクについては、「リファレンス」セクションを参照してください)。この潜在的な問題を回避するために、コードサンプルでは Date フィールドがバリアント文字列として書式設定されていることに注意してください。

配列を Excel ワークシートにコピーする前に、TransposeDim() 関数を使用して配列を移調します。配列を入れ替えるために独自の関数を作成する代わりに、次に示すように、サンプルコードを変更して配列をセルに割り当てることで、Excel の Transpose 関数を使用できます。

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

TransposeDim() 関数の代わりに Excel の Transpose メソッドを使用して配列を入れ替える場合は、Transpose メソッドでは次の制限事項に注意する必要があります。

配列には、255 文字を超える要素を含めることはできません。
配列に Null 値を含めることはできません。
配列内の要素の数は 5461 を超えることはできません。

Excel ワークシートに配列をコピーするときに上記の制限が考慮されない場合は、次のいずれかの実行時エラーが発生する可能性があります。

実行時エラー 13: 型の不一致

実行時エラー 5: 無効なプロシージャ

呼び出しまたは引数の実行時エラー 1004: アプリケーション定義またはオブジェクト定義エラー

オートメーションを使用して ADO Recordset から Excel にデータを転送する方法

概要

詳細情報

サンプルを作成する手順

CopyFromRecordset の使用

GetRows の使用

関連情報

その他のリソース