演習31 「DAO」 の解説 その1
DAO (Data Access Objects) は、Microsoft Office におけるデータアクセス
方式で、主に 「Microsoft Jet Database Engine」と呼ばれるデータベース
エンジンを操作するためのオブジェクトである。
Office 2000 では「DAO 3.6」の最新バージョンが使用されており、Jetデータ
ベースエンジンのバージョンは Jet4.0 となっている。 Microsoft Access は、
この Jetデータベースエンジンを使用して作られているので、DAO を用いること
により、Excel から Access のデータベースファイルを操作することができる。
そのために、最初に Excel VBA の VBエディタ において、次の設定を行う。
VBE - ツール - 参照設定 - (レ)Microsoft DAO 3.6 Object Library
標準モジュールに、以下の三つのプロシージャの いずれかを記述し実行すると、
Excel シート上のデータを、Access のテーブル上に転記をすることができる。
例として、演習30「Msqry SQL」 kakcyo06.htm の (9) で、SQL 文 を用いて
新規作成した空の テーブル4 に、Excel からデータを送り込んでみる。結果は
次のとおりである。
なお、ここで紹介するコードは、次の 「MOUG 掲示板 Excel VBA Q&A」 に掲載
されたコードを参考にした。
http://www2.moug.net/cgi-bin/mdboard.cgi?exvba+ID0001
==> 
Sub excel_access1()
Dim rno As Excel.Range 'エクセル 初期範囲設定
Dim rng As Excel.Range 'エクセル 各セルデータ
Dim dbs As DAO.Database 'アクセス ファイル指定
Dim rcs As DAO.Recordset 'アクセス テーブル指定
Dim fld As Long 'アクセス 列指定
'例として acctest2.mdb の テーブル4 に書き込む
Set dbs = OpenDatabase(Name:=ActiveWorkbook.Path & _
"\" & "acctest2.mdb")
Set rcs = dbs.OpenRecordset(Name:="テーブル4")
With Worksheets("Sheet1").Range("A1").CurrentRegion
'エクセルシートの1列目
Set rno = .Resize(.Rows.Count - 1, 1).Offset(1, 0)
For Each rng In rno
rcs.AddNew 'レコード追加データ記入
For fld = 0 To rcs.Fields.Count - 1
'アクセスに1行づつ書き込み
Let rcs.Fields(fld).Value = _
rng.Offset(0, fld).Value '右へ一列づつ
Next 'ずれていく
rcs.Update 'レコードデータ保存
Next
End With
rcs.Close
dbs.Close
Set rcs = Nothing
Set dbs = Nothing
Set rno = Nothing
End Sub
'------------------------------------------------------
Sub excel_access2()
Dim dbs As DAO.Database 'アクセス ファイル指定
Dim rcs As DAO.Recordset 'アクセス テーブル指定
Dim mtr As Variant 'エクセル 全データ
Dim rcd As Long 'アクセス 行指定
Dim fld As Long 'アクセス 列指定
'例として acctest2.mdb の テーブル4 に書き込む
Set dbs = OpenDatabase(Name:=ActiveWorkbook.Path & _
"\" & "acctest2.mdb")
Set rcs = dbs.OpenRecordset(Name:="テーブル4")
With Worksheets("Sheet1").Range("A1").CurrentRegion
'エクセルシート全データ範囲(2次元配列)
Let mtr = .Resize(.Rows.Count - 1).Offset(1, 0).Value
For rcd = LBound(mtr, 1) To UBound(mtr, 1) '1次行
rcs.AddNew 'LB:最小値(1) UB:最大値(5)
For fld = LBound(mtr, 2) To UBound(mtr, 2) '2次列
'アクセスに行列で書き込み
Let rcs.Fields(fld - 1).Value = mtr(rcd, fld)
Next
rcs.Update
Next
End With
rcs.Close
dbs.Close
Set rcs = Nothing
Set dbs = Nothing
End Sub
'------------------------------------------------------
Sub excel_access3()
Dim dbs As DAO.Database 'アクセス ファイル指定
Dim strSQLstring As String 'SQL文
'例として acctest1.xls と acctest2.mdb
'の二つを C:\直下に置いてある
'SQL文を記述
Let strSQLstring _
= "insert into テーブル4 " & vbNewLine _
& "select * " & vbNewLine _
& "from [Sheet1$] " & vbNewLine _
& "in 'C:\acctest1.xls' 'Excel 8.0;' " & vbNewLine
Set dbs = OpenDatabase(Name:="C:\acctest2.mdb")
'SQL実行
dbs.Execute Query:=strSQLstring
dbs.Close
Set dbs = Nothing
End Sub
DAO その2 へ移る. back top