シート上のデータを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」の値を検索して同じ値があれば、追加処理はしない。
また、転記元セルの背景色を変更している。