【AccessVBA】ループ処理でDB参照・更新

ポイント

• ADODB接続
• ループ処理で ➀DB参照 ➁DB更新　※基本編
• ループ処理で ➂➃DB更新　※応用編
• エラーハンドリング

➀DB参照　＆　エラーハンドリング

本テーブル（参照）

Public Function func_aaa() As Boolean
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strSQL As String
    On Error GoTo ErrorExit  

    Set conn = CurrentProject.Connection
    Set rs = New ADODB.Recordset

    ' SELECT文
    strSQL = ""
    strSQL = strSQL & "SELECT 顧客ID, 顧客名" & vbCrLf
    strSQL = strSQL & "FROM 顧客マスタ" & vbCrLf
    strSQL = strSQL & "WHERE 有効フラグ = True" & vbCrLf
    rs.Open strSQL, conn, adOpenForwardOnly, adLockReadOnly '読み取り専用

    Do Until rs.EOF
        '値を表示
        Debug.Print rs!顧客ID & "：" & rs!顧客名
        
        rs.MoveNext
    Loop

    GoTo EndExit

ErrorExit:
    MsgBox "エラーが発生しました：" & Err.Description, vbCritical

EndExit:
    On Error Resume Next
    If Not rs Is Nothing Then rs.Close
    Set rs = Nothing
    Exit Function
    
End Function

➁DB更新（一部抜粋）

本テーブル（更新）

   '(略)
   
    ' SELECT文
    strSQL = ""
    strSQL = strSQL & "SELECT 顧客ID, 顧客名" & vbCrLf
    strSQL = strSQL & "FROM 顧客マスタ" & vbCrLf
    strSQL = strSQL & "WHERE 有効フラグ = True" & vbCrLf
    rs.Open strSQL, conn, adOpenKeyset, adLockOptimistic '更新可

    Do Until rs.EOF
        '値を更新
        rs!顧客名 = rs!顧客名 & "（更新済）"
        rs.Update
        
        rs.MoveNext
    Loop

   '(略)

➂DB更新（別テーブルrs2を参照して更新）

本テーブル（更新）← 別テーブル（参照）

   '(略)
   
   ' SELECT文
    strSQL = ""
    strSQL = strSQL & "SELECT 顧客ID, 顧客名" & vbCrLf
    strSQL = strSQL & "FROM 顧客マスタ" & vbCrLf
    strSQL = strSQL & "WHERE 有効フラグ = True" & vbCrLf
    rs.Open strSQL, conn, adOpenKeyset, adLockOptimistic '更新可

    Do Until rs.EOF
        'rs2をNewする
        Set rs2 = New ADODB.Recordset
        
        strSQL = ""
        strSQL = strSQL & "SELECT 顧客ID, 顧客名" & vbCrLf
        strSQL = strSQL & "FROM 顧客マスタ_追加分" & vbCrLf
        strSQL = strSQL & "WHERE 顧客ID = " & rs!顧客ID & vbCrLf        
        rs2.Open strSQL, conn, adOpenForwardOnly, adLockReadOnly '読み取り専用

        '値を更新
        rs!顧客名 = rs2!顧客名
        rs.Update

        'rs2をCloseする（再利用するため）
        rs2.Close
        Set rs2 = Nothing
        
        rs.MoveNext
    Loop

   '(略)

➃DB更新（別テーブルをINSERT/UPDATE文で更新）

本テーブル（参照）→ 別テーブル（更新）

   '(略)
   
    ' SELECT文
    strSQL = ""
    strSQL = strSQL & "SELECT 顧客ID, 顧客名" & vbCrLf
    strSQL = strSQL & "FROM 顧客マスタ" & vbCrLf
    strSQL = strSQL & "WHERE 有効フラグ = True" & vbCrLf
    rs.Open strSQL, conn, adOpenForwardOnly, adLockReadOnly '読み取り専用

    Do Until rs.EOF
        strSQL = ""
        strSQL = strSQL & "INSERT INTO 顧客マスタ_履歴" & vbCrLf
        strSQL = strSQL & "    (顧客ID, 顧客名)" & vbCrLf
        strSQL = strSQL & "SELECT" & vbCrLf
        strSQL = strSQL & "    顧客マスタ.顧客ID" & vbCrLf
        strSQL = strSQL & "    , 顧客マスタ.顧客名" & vbCrLf   
        strSQL = strSQL & "WHERE 顧客ID = " & rs!顧客ID & vbCrLf 
        '別テーブルを更新
        conn.Execute strSQL
        
        rs.MoveNext
    Loop
    
   '(略)

補足

ADODB接続

• CurrentProject.Connection（自身のAccessDBに接続）の場合、.Openと.Closeは不要
• 途中でカーソル移動が伴う場合は下記が必要

    rs.Open strSQL, conn, adOpenForwardOnly, adLockReadOnly '読み取り専用
    '(上記略)
    
    If Not rs.EOF Then
        rs.MoveFirst
    End If
    
    '(下記略)
    Do Until rs.EOF

• rsは一旦Close、Newすれば、再利用可能

        rs.MoveNext
    Loop
    '(上記略)
    
    rs.Close
    Set rs = Nothing
    
    Set rs = New ADODB.Recordset

    '(下記略)
    strSQL = ""
    strSQL = strSQL & "SELECT aaa FROM bbb" & vbCrLf
    rs.Open strSQL, conn, adOpenForwardOnly, adLockReadOnly