소개

Access에서 선불 문을 실행하고 싶습니다.
여러가지 조사하고 있으면 일단 그럴듯한 것은 있는 것이었기 때문에, 시험했는데, 아무래도 문자 코드로 에러가・・・.
아무래도 DNS MySQL ODBC 5.3 Unicode Driver 의 지정이 잘못되어 있었던 것 같고, MySQL ODBC 5.3 ANSI Driver 로 변경했는데 정상적으로 패스했기 때문에 공개.
또한 환경은 여기에 상세히 기재되어 있습니다.

클래스 모듈

MySql.cls

Option Compare Database
Option Explicit
' **
' * モジュール名     ： MySql
' *
' * メソッド
' * connect            : MySQLとのコネクションを確立する
' * prepare            : Prepared Statementを発行する
' * setParameterHash   : Prepared Statement用のパラメータをコレクションにセットする
' * clearParameterHash : コレクションの中身を空にする（連続処理時に使用）
' * setParameter       : コレクションをPrepared Statementにセットする
' * executeStmt        : SQL文を実行する（INSERT・UPDATE用）
' * fetchStmt          : レコードセットを取得する（SELECT用）
' **

Private ado_connection As Object
Private ado_command    As Object
Private parameter_hash As Object

' **
' * メソッド名 : connect
' * 機能       : MySQLとのコネクションを確立する
' * 引数       : なし
' * 戻り値     : 自分自身（チェーンメソッド）
' **
Public Function connect() As MySql
On Error GoTo Error
    Dim cn      As String
    Dim ado_con As Object

    Set ado_con = CreateObject("ADODB.Connection")

    ' ドライバ他接続用のパラメータ
    cn = "Driver={MySQL ODBC 5.3 ANSI Driver};" & _
         "Server=192.168.10.10;" & _
         "PORT=3306;" & _
         "UID=access;" & _
         "PWD=access;"
    ' DriverにUnicodeを指定した場合、プリペアドステートメント実行時に文字コードエラーが発生する

    ' 接続用のパラメータを利用してデータベースとのコネクションを確立する
    ado_con.Open (cn)
    ' コネクションをオブジェクトにセットする
    Set ado_connection = ado_con
    ' 自分自身を返す
    Set connect = Me
    Exit Function
Error:
    MsgBox Err.Number & vbCrLf & Err.Description
End Function

' **
' * メソッド名： prepare
' * 機能      ： prepared statementを発行する（現時点ではSQL文を実行しない）
' * 引数      ： sql文（パラメータは?で指定する）
' * 戻り値    ： 自分自身（チェーンメソッド）
' **
Public Function prepare(sql As Variant) As MySql
On Error GoTo Error
    Dim cmd As Object
    Set cmd = CreateObject("ADODB.Command")

    ' コマンドのコネクションに予め確立していたコネクションをセット
    cmd.ActiveConnection = ado_connection

    ' プリペアドステートメントを発行
    With cmd
        .CommandText = sql
        .CommandType = adCmdText
        .Prepared    = True
    End With
    Set ado_command  = cmd
    Set prepare      = Me
    Exit Function
Error:
    MsgBox Err.Number & vbCrLf & Err.Description
End Function

' **
' * メソッド名： setParameter
' * 機能      ： 生成したパラメータをSQL文に埋め込む（実行はまだ行わない）
' * 引数      ： なし
' * 戻り値    ： 自分自身（チェーンメソッド）
' **
Public Function setParameter()
On Error GoTo Error
    Dim param As Object
    Dim key   As Variant
    Dim arr   As Object

    Set param = New ADODB.parameter

    If parameter_hash Is Nothing Then
        ' パラメータが存在しない平文の場合、処理をスルー
    Else
        ' パラメータが存在する場合、一つ一つにセットしていく
        For Each key In parameter_hash
            ' arrに1レコードごとのパラメータをセット
            Set arr = parameter_hash.Item(key)

            'パラメータを利用してクエリにセット
            Set param = ado_command.CreateParameter(key, arr.Item("type"), adParamInput, arr.Item("size"))
            ado_command.parameters.Append param
            ado_command.parameters(key) = arr.Item("value")

        Next key
    End If
    Set ado_command  = ado_command
    Set setParameter = Me
    Exit Function
Error:
    MsgBox Err.Number & vbCrLf & Err.Description
End Function

' **
' * メソッド名： executeStmt
' * 機能      ： プリペアドステートメントを実行する（INSERT・UPDATE用）
' * 引数      ： なし
' * 戻り値    ： 自分自身（チェーンメソッド）
' **
Public Function executeStmt()
    ado_command.Execute
End Function

' **
' * メソッド名： fetchStmt
' * 機能      ： プリペアドステートメントを実行する（SELECT用）
' * 引数      ： なし
' * 戻り値    ： レコードセット
' **
Public Function fetchStmt()
    Dim res
    Set res       = New ADODB.Recordset
    Set res       = ado_command.Execute
    Set fetchStmt = res
End Function

' **
' * メソッド名： setParameterHash
' * 機能      ： プリペアドステートメント用のキーと値をコレクションにセットする
' * 引数      ： キー（カラム名）・値・変数型・変数長
' * 戻り値    ： 自分自身（チェーンメソッド）
' * 備考      ： Typeについては https://msdn.microsoft.com/ja-jp/library/cc389790.aspx を参照
' **
Public Function setParameterHash(param_key As String,
                                 param_value As Variant,
                                 param_type As Variant,
                                 param_size As Variant) As MySql
On Error GoTo Error
    If parameter_hash Is Nothing Then
        ' パラメータ用連想配列が存在しなければこの時点で生成
        Set parameter_hash = CreateObject("Scripting.Dictionary")
    End If

    Dim param As Object
    ' parameterを連想配列化
    Set param = CreateObject("Scripting.Dictionary")
    param.Add key:="value", Item:=param_value
    param.Add key:="type",  Item:=param_type
    param.Add key:="size",  Item:=param_size
   'param.Add key:="size",  Item:=Len(param_value) ' テストしてないけど多分これでも通る、こうすると引数1つ減らせる

    ' ハッシュマップに連想配列をセット
    parameter_hash.Add key:=param_key, Item:=param

    Set param            = Nothing
    Set setParameterHash = Me
    Exit Function
Error:
    MsgBox Err.Number & vbCrLf & Err.Description
End Function

' **
' * メソッド名： clearParameterHash
' * 機能      ： コレクションの中身を空にする（連続処理時に使用）
' * 引数      ： なし
' * 戻り値    ： 自分自身（チェーンメソッド）
' **
Public Function clearParameterHash() As MySql
    Set parameter_hash = Nothing
    Set clearParameterHash = Me
End Function

주요 양식

form_1.cls

' INSERTテスト
Private Sub button_1_Click()
    dim obj as Object
    Set obj = New MySql

    sql = "INSERT INTO access_db.sample_tables (id, message, modified_at) VALUES (null, ?, ?);"
    obj. _
        connect(). _
        prepare(sql). _
        setParameterHash("message",     "テストメッセージです。", adChar,        100). _
        setParameterHash("modified_at", Now(),                  adDBTimeStamp, 16). _
        setParameter(). _
        executeStmt

    MsgBox "INSERTが終了しました。"
End Sub

' UPDATEテスト
Private Sub button_2_Click()
    dim obj as Object
    Set obj = New MySql

    sql = "UPDATE access_db.sample_tables SET message=?, modified_at=? WHERE id=?;"
    obj. _
        connect(). _
        prepare(sql). _
        setParameterHash("message",     "編集しました。", adChar,        100). _
        setParameterHash("modified_at", Now(),           adDBTimeStamp, 16). _
        setParameterHash("id",          1,               adInteger,     8). _
        setParameter(). _
        executeStmt

    MsgBox "UPDATEが終了しました。"
End Sub

' DELETEテスト
Private Sub button_3_Click()
    dim obj as Object
    Set obj = New MySql

    sql = "DELETE FROM access_db.sample_tables WHERE id=?;"
    obj. _
        connect(). _
        prepare(sql). _
        setParameterHash("id", 1, adInteger, 8). _
        setParameter(). _
        executeStmt

    MsgBox "DELETEが終了しました。"
End Sub

' SELECTテスト － パラメータなし
Private Sub button_4_Click()
    dim obj as Object
    Set obj = New MySql

    sql = "SELECT * FROM access_db.sample_tables;"
    Set rs = obj. _
        connect(). _
        prepare(sql). _
        fetchStmt
        ' setParameterHash,setParameterなし
        ' execute -> fetchへ

    Do Until rs.EOF
        debug.print "id=" & rs!id & ", message='" & rs!message & "'"
        rs.MoveNext
    Loop
    MsgBox "SELECTが終了しました。"
End Sub

' まとめてINSERTしてみる
Private Sub button_5_Click()
    Set obj = New MySql
    sql = "INSERT INTO access_db.sample_tables (id, message, modified_at) VALUES (null, ?, ?);"

    For i = 1 To 1000
    obj.connect().prepare(sql). _
        clearParameterHash(). _
        setParameterHash("message", "テストメッセージ" & i, adChar, 20). _
        setParameterHash("updated_at", Now(), adDBTimeStamp, 16). _
        setParameter(). _
        executeStmt
    Next
    MsgBox "INSERTが終了しました。"

End Sub

주의사항

대량의 데이터로 테스트를 한 것은 아니므로 어쩌면 이런 오류이 나올지도 모릅니다. 스테이트먼트 발행할 때마다 오브젝트 파기하면 회피할 수 있을까? 하지만 모범 사례는 아닙니다.

setParameterHash의 Type에 대해서는 여기를 참조해 주세요.

setParameterHash의 Size에 대해서는 여기 생략 가능하다고 쓰고 있는데 생략한 순간 에러 토한다는 의미 모르겠지.

Size에 대해서 써 있어 생각했지만 인수의 param_value 의 length 그대로 세트라도 괜찮지? 라는 것으로 코멘트에 기재. 일단 테스트는 하고 있지만, 전부의 형태를 테스트한 것은 아니다.

소감

알면 무슨 일도 없는 에러였습니다만, 반나절 가까이 빠졌습니다.
잠시 문자 코드를 생각하고 싶지 않습니다.
우선, 프리 페어 스테이트먼트를 실행할 수있게되었습니다.
그리고는 트랜잭션이나 커밋이나・・・우, 응.