【AccessVBA】カラム一覧を配列にして、SQL文作成を効率化する

ポイント

• 配列を使用
• SELECT文作成
• INSERT文作成
• UPDATE文作成

カラム一覧（定数）を用意

M_CONST

Public Const strCols_顧客マスタ AS String = "顧客名,フリガナ,郵便番号,住所,電話番号,メールアドレス"

SELECT文

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

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

    '配列を作成
    arrCols = Split(M_CONST.strCols_顧客マスタ, ",")
    
    ' SELECT文
    strSQL = ""
    strSQL = strSQL & "SELECT" & vbCrLf
    strSQL = strSQL & "    [顧客ID]" & vbCrLf
    For i = LBound(arrCols) To UBound(arrCols) '配列から取得
        strSQL = strSQL & ", [" & arrCols(i) & "]" & vbCrLf
    Next
    strSQL = strSQL & "FROM 顧客マスタ" & vbCrLf
    rs.Open strSQL, conn, adOpenForwardOnly, adLockReadOnly '読み取り専用

    Do Until rs.EOF
        '（任意の処理を入れる）
        rs.MoveNext
    Loop

    func_aaa = True
    
    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

INSERT文

Public Function func_aaa() As Boolean
    Dim conn As ADODB.Connection
    Dim arrCols As Variant
    Dim strSQL As String
    Dim i As Long
    On Error GoTo ErrorExit  

    func_aaa = False
    
    Set conn = CurrentProject.Connection

    '配列を作成
    arrCols = Split(M_CONST.strCols_顧客マスタ, ",")
    
    ' INSERT文
    strSQL = ""
    strSQL = strSQL & "INSERT INTO 顧客マスタ (" & vbCrLf
    strSQL = strSQL & "    [顧客ID]" & vbCrLf
    For i = LBound(arrCols) To UBound(arrCols) '配列から取得
        strSQL = strSQL & ", [" & arrCols(i) & "]" & vbCrLf
    Next
    strSQL = strSQL & "    )" & vbCrLf
    strSQL = strSQL & "SELECT" & vbCrLf
    strSQL = strSQL & "    REF.[顧客ID]" & vbCrLf
    For i = LBound(arrCols) To UBound(arrCols) '配列から取得
        strSQL = strSQL & ", REF.[" & arrCols(i) & "]" & vbCrLf
    Next
    strSQL = strSQL & "FROM 顧客マスタ_追加分 AS REF" & vbCrLf
    conn.Execute strSQL

    func_aaa = True
    
    GoTo EndExit

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

EndExit:
    On Error Resume Next
    Exit Function
    
End Function

UPDATE文

Public Function func_aaa() As Boolean
    Dim conn As ADODB.Connection
    Dim arrCols As Variant
    Dim strSQL As String
    Dim i As Long
    On Error GoTo ErrorExit  

    func_aaa = False
    
    Set conn = CurrentProject.Connection

    '配列を作成
    arrCols = Split(M_CONST.strCols_顧客マスタ, ",")
    
    ' UPDATE文
    strSQL = ""
    strSQL = strSQL & "UPDATE 顧客マスタ AS UPD" & vbCrLf
    strSQL = strSQL & "INNER JOIN 顧客マスタ_変更分 AS REF" & vbCrLf
    strSQL = strSQL & "  ON UPD.[顧客ID] = REF.[顧客ID]" & vbCrLf
    strSQL = strSQL & "SET" & vbCrLf
    For i = LBound(arrCols) To UBound(arrCols) '配列から取得
        If i <> LBound(arrCols) Then
            strSQL = strSQL & ", " '２行目以降は行頭にカンマ
        End If
        strSQL = strSQL & "UPD.[" & arrCols(i) & "] = REF.[" & arrCols(i) & "]" & vbCrLf
    Next
    conn.Execute strSQL

    func_aaa = True
    
    GoTo EndExit

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

EndExit:
    On Error Resume Next
    Exit Function
    
End Function