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
  'エクセルシートの１列目
  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
          'アクセスに１行づつ書き込み
          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
  'エクセルシート全データ範囲(２次元配列)
  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 その２ へ移る.　　　　　　　　　　　　　　　　　　　　　　　　　　　　back top