Microsoft Access 掲示板

VBAでSQL更新 / 10

16 コメント
views
4 フォロー
10
'各コントロールの値に応じた UPDATE 文を生成する関数
Private Function CreateUpdateStatement() As String
On Error GoTo Err_CreateUpdateStatement

    CreateUpdateStatement = ""

    Dim strUpdateClause As String
    Dim strSetClause As String
    Dim strWhereClause As String

    With Me
        
        'UPDATE 句の設定
        strUpdateClause = "UPDATE [T_1] "
        
        'ここから SET 句の設定
        strSetClause = ""
        
        '[F1]に対する代入式の設定
        If IsNumeric(![c1].Value) = True Then
            strSetClause = strSetClause & ", " & _
                           "[F1]=" & CDec(![c1].Value)
        Else
            strSetClause = strSetClause & ", " & _
                           "[F1]=Null"
        End If
        
        '[F2]に対する代入式の設定
        If IsNumeric(![c2].Value) = True Then
            strSetClause = strSetClause & ", " & _
                           "[F2]=" & CCur(![c2].Value)
        Else
            strSetClause = ", " & _
                           "[F2]=Null"
        End If
        
        '[F3]に対する代入式の設定
        If IsDate(![c3].Value) = True Then
            strSetClause = strSetClause & ", " & _
                           "[F3]=#" & Format(![c3].Value, "yyyy/mm/dd hh:nn:ss") & "#"
        Else
            strSetClause = strSetClause & ", " & _
                           "[F3]=Null"
        End If
        
        '[F4]に対する代入式の設定
        If Nz(![c4].Value, "") <> "" Then
            strSetClause = strSetClause & ", " & _
                           "[F4]='" & Replace(![c4].Value, "'", "''", 1, -1, vbBinaryCompare) & "'"
        Else
            strSetClause = strSetClause & ", " & _
                           "[F4]=Null"
        End If
        
        strSetClause = "SET " & Mid(strSetClause, 2) & " "
        
        'ここまで SET 句の設定
        
        'ここから WHERE 句の設定
        
        If IsNumeric(![txtID].Value) = True Then
            strWhereClause = "WHERE [ID]=" & CLng(![txtID].Value)
        Else
            '[ID]の指定が正しくなければ戻り値を空文字のまま終了
            Exit Function
        End If
        
        'ここまで WHERE 句の設定

    End With
        
    'UPDATE 句、SET 句、WHERE 句を連結して 1 つの SQL 文とした結果を戻り値として返す
    CreateUpdateStatement = strUpdateClause & vbCrLf & _
                            strSetClause & vbCrLf & _
                            strWhereClause & ";"

'終了処理
Exit_CreateUpdateStatement:

    Exit Function

'エラー時処理
Err_CreateUpdateStatement:

    Dim strErrTitle As String
    Dim strErrMsg As String

    strErrTitle = "実行時エラー (" & Me.Name & ".CreateUpdateStatement)"
    strErrMsg = Err.Number & ": " & Err.Description

    Debug.Print strErrTitle
    Debug.Print strErrMsg

    MsgBox strErrMsg, vbCritical, strErrTitle

    CreateUpdateStatement = ""

End Function
通報 ...
  • 12

    1箇所修正。

    strUpdateClause = "UPDATE [T_1] "

            strUpdateClause = "UPDATE [" & SourceTableName & "] "
    
  • 13

    もう1箇所。

                strSetClause = ", " & _
                               "[F2]=Null"

                strSetClause = strSetClause & ", " & _
                               "[F2]=Null"