HOME > 即効テクニック > Excel VBA > その他関連のテクニック > Excelユーザのデータベース活用法-ADOレコードセットからワークシートへ

Excelユーザのデータベース活用法-ADOレコードセットからワークシートへ|Excel VBA

その他関連のテクニック

Excelユーザのデータベース活用法-ADOレコードセットからワークシートへ

(Excel 2000)

エクセルではさまざまな方法で外部からデータを取得することができますが、
以下のサンプルではアクセスMDBからレコードセットを取得し、フィールド名とデータをワークシートに書き出します。
データの書き出しにはCopyFromRecordsetメソッドを用いています。

前提: ※サンプル1、2ともに共通

・Microsoft ActiveX Data Objects X.X Object Library の参照設定
・”C:\販売管理.mdb”内に”顧客ID,商品ID,個数,単価”フィールドをもつ”売上”テーブル

■1.レコードセットからCopyFromRecordsetメソッドでデータ取得■
Sub GetDataFromADODBRS()

Dim MySql As String, MyPath As String
Dim i  As Integer
Dim Conn As ADODB.Connection
Dim Rst As ADODB.Recordset
Set Conn = New ADODB.Connection

MyPath = "c:\販売管理.mdb" 'データベースの指定
Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                & "Data Source=" & MyPath & ";"
Conn.Open '接続の確立

'販売管理.mdb内の売上テーブルよりすべてのデータを取得。
'日付フィールドを基準に降順ソート
MySql = "select * from 売上 order by 日付 desc;"

Set Rst = New ADODB.Recordset
Rst.Open MySql, Conn, adOpenStatic, adLockReadOnly, adCmdText

'フィールド名の書き出し
For i = 0 To Rst.Fields.Count - 1
ActiveSheet.Cells(1, i + 1).Value = Rst.Fields(i).Name
Next i
'CopyFromRecordsetメソッドで基準セルを指定してデータの書き出し
ActiveSheet.Range("a2").CopyFromRecordset Rst

Rst.Close: Conn.Close
Set Rst = Nothing: Set Conn = Nothing

また、Microsoft Queryを使用したデータベースクエリでは、ADOレコードセットからのデータ取得も可能です。
以下のサンプルはQueryTableを使用して上記サンプルと同様、ワークシートにフィールド名、データを書き出します。

■2.データベースクエリでADODBレコードセットを使用する■
Sub GetDataByQueryTable()

Dim QT As QueryTable
Dim MySql As String, MyPath As String
Dim Conn As ADODB.Connection
Dim Rst As ADODB.Recordset
Set Conn = New ADODB.Connection

MyPath = "c:\販売管理.mdb"
Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                & "Data Source=" & MyPath & ";"
Conn.Open

'販売管理.mdb内の売上テーブルよりフィールドを指定して
'データを取得。顧客IDフィールドを基準に昇順ソート
MySql = "select 顧客ID,商品ID,個数,単価" _
       & " from 売上 order by 顧客ID ASC;"

Set Rst = New ADODB.Recordset
Rst.Open MySql, Conn, adOpenStatic, adLockReadOnly, adCmdText

Set QT = ActiveSheet.QueryTables.Add _
    (Connection:=Rst, Destination:=Range("A1"))
QT.Name = "MyQuery"
QT.Refresh

Rst.Close: Conn.Close
Set Rst = Nothing: Set Conn = Nothing

End Sub