ExcelからAccessのテーブルにADOを使って書き込みを実行する

ExcelのワークシートからAccessにADOを使って接続し、テーブルに書き込むVBAを作成してみましょう。
今回の事例ではIDをキーとしたテーブルへの新規登録・更新までのお手軽なサンプルです。

尚、今回の関連記事としてADOを使ってテーブルを読み込む「ADOを使ってExcelからAccessデータを利用してみよう」があります。ExcelのシートやAccessのテーブルは前回のものをそのまま利用しますので、テーブルデザインや参照設定等はそちらのエントリーをご参考下さい。

テーブルをADOで書き込む為のVBAコード

Sub DB_Write()
Dim adoCON      As New ADODB.Connection
Dim adoRS       As New ADODB.Recordset
Dim strSQL      As String
Dim odbdDB      As Variant
Dim wSheetName  As Variant
Dim i           As Integer
Dim wLastGyou As Long

'カレントディレクトリのデータベースパスを取得
odbdDB = ActiveWorkbook.Path & "\sample.accdb"

'データベースに接続する
adoCON.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" _
                    & "Data Source=" & odbdDB & ""
adoCON.Open

'トランザクション開始
adoCON.BeginTrans

'アクティブなシート名を取得
wSheetName = ActiveSheet.Name
 
With Worksheets(wSheetName)
        
'最終行番号を取得
wLastGyou = .UsedRange.Rows.Count
        
'Excelの一覧を読み込みAccessに書き込む
For i = 3 To wLastGyou
        
    'IDの数値チェック（数字の場合は処理を実行）
    If IsNumeric(.Cells(i, 1).Value) And _
                        .Cells(i, 1).Value <> "" Then
    
        'DB接続用SQL
        strSQL = "SELECT T_item.* FROM T_item "
        strSQL = strSQL & "WHERE ID = " & CLng(.Cells(i, 1).Value) & " ;"
        'カーソルをクライアント側に設定
        adoRS.CursorLocation = adUseClient
        'レコードセットを開く
        adoRS.Open strSQL, adoCON, adOpenKeyset, adLockOptimistic
        
        '入力されたIDと同一のレコードが無い場合は新規登録
        If adoRS.EOF Then
            adoRS.AddNew
            adoRS!ID = CLng(.Cells(i, 1).Value)
        End If
        
        adoRS!商品名 = .Cells(i, 2).Value
        adoRS!品番 = .Cells(i, 3).Value
        If IsNumeric(.Cells(i, 4).Value) Then
            adoRS!単価 = CLng(.Cells(i, 4).Value)
        Else
            adoRS!単価 = 0
        End If
        If IsNumeric(.Cells(i, 5).Value) Then
            adoRS!入数 = CLng(.Cells(i, 5).Value)
        Else
            adoRS!入数 = 0
        End If
        
        adoRS.Update
    
        'レコードセットを閉じる
        adoRS.Close: Set adoRS = Nothing
    
    End If

Next i

End With

'トランザクション終了
adoCON.CommitTrans

'ADOコネクションオブジェクトのクローズ処理
adoCON.Close: Set adoCON = Nothing
        
End Sub

VBAコードの解説

ADOの参照設定やデータベースへの接続方法は以前のエントリーをご参考下さい。
[DB書き込み]ボタンのクリック時のVBAは以下の通りです。

For～NextステートメントでExcelの一覧を読み込む

For～Nextステートメントを使って3行目から最終行までの一覧を繰り返し読み込みます。
※サンプルコード30行目～70行目

For i = 3 To wLastGyou
    '省略
Next i

ID（A列）の数値チェック

IsNumeric関数を使いIDの数字チェックを行います。IDが数字かつ空白で無い場合に処理を続行します。
※サンプルコード33行目～34行目

If IsNumeric(.Cells(i, 1).Value) And _
                    .Cells(i, 1).Value <> "" Then

Accessのレコードセットを開きます

キー項目のIDで抽出するSQL（SELECT文）をセットし、Openメソッドでレコードセットを開きます。
※サンプルコード36行目～42行目

'DB接続用SQL
strSQL = "SELECT T_item.* FROM T_item "
strSQL = strSQL & "WHERE T_item.ID = " & CLng(.Cells(i, 1).Value) & " ;"
'カーソルをクライアント側に設定
adoRS.CursorLocation = adUseClient
'レコードセットを開く
adoRS.Open strSQL, adoCON, adOpenKeyset, adLockOptimistic

レコードの存在チェック

上記SQLより指定したIDが存在しない場合（adoRS.EOF）はAddNewメソッドを使い新規レコードを追加します。また、新規登録の場合のみキー項目のIDをセットするようにします。
※サンプルコード45行目～48行目

If adoRS.EOF Then
    adoRS.AddNew
    adoRS!ID = CLng(.Cells(i, 1).Value)
End If

各セルの値をレコードにセット

各セルの値をレコードの項目にそれぞれセットしUpdateメソッドで更新します。また、単価と入数の項目はIsNumeric関数を使い数値以外の場合に0をセットするようにします。
※サンプルコード50行目～63行目

adoRS!商品名 = .Cells(i, 2).Value
adoRS!品番 = .Cells(i, 3).Value
If IsNumeric(.Cells(i, 4).Value) Then
    adoRS!単価 = CLng(.Cells(i, 4).Value)
Else
    adoRS!単価 = 0
End If
If IsNumeric(.Cells(i, 5).Value) Then
    adoRS!入数 = CLng(.Cells(i, 5).Value)
Else
    adoRS!入数 = 0
End If

adoRS.Update

レコードセットをクローズします

Closeメソッドを使いレコードセットを閉じます。また、変数にNothingをセットしてクリアします。
※サンプルコード66行目

'レコードセットを閉じる
adoRS.Close: Set adoRS = Nothing

以上、今回はExcelからAccessのテーブルにADOを使って書き込む方法についてでした。