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



