シート上のデータをmdb側に追加する

スポンサーリンク
スポンサーリンク

シート上のデータをmdb側に追加する

Sub レコード追加()
Dim myCon As New ADODB.Connection, myRS As New ADODB.Recordset, FileName As String
Dim myTbl As String, myRng As Range, i As Integer, j As Integer

'接続先のファイル、レコード追加テーブル、追加元を指定
FileName = ThisWorkbook.Path & "\mdb\2-sampleDB.mdb"
myTbl = "社員"
Set myRng = ThisWorkbook.Worksheets("List4-20").Range("A1").CurrentRegion

'接続
myCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName

'対象テーブルを参照
myRS.Open myTbl, myCon, adOpenStatic, adLockPessimistic, adCmdTableDirect

'キー列を指定
myRS.Index = "社員ID"

For i = 2 To myRng.Rows.Count
  'キー列を検索
  myRS.Seek myRng(i, 1).Value
  
  If myRS.EOF Then
    '「社員ID」が見つからない場合は新規レコード追加
    myRS.AddNew
    For j = 1 To myRng.Columns.Count
      '転記元のフィールド名に該当する転記先フィールドに値を追加
      myRS.Fields(myRng(1, j).Value).Value = myRng(i, j).Value
    Next
  Else
    '「社員ID」が存在する場合は新規レコード追加処理はせず、転記元の背景色を変更
    myRng.Rows(i).Interior.ColorIndex = 35
  End If
Next

'変更を一括して反映
myRS.Update

myRS.Close: Set myRS = Nothing
myCon.Close: Set myCon = Nothing

End Sub

上記のリストはExcelシートのデータをAccessのテーブルに追加する基本形である。

変数 変数の内容
FileName データを追加する「mdb」ファイル
myTbl データを追加するテーブル
myRng 転記元となるExcelシート上のセル範囲

キー列「社員ID」の値を検索して同じ値があれば、追加処理はしない。
また、転記元セルの背景色を変更している。

「社員テーブル」

実行結果


スポンサーリンク
シェアする
スポンサーリンク
あんとんさんち 覚え書き