【Access】VBAを実行したら「実行時エラー”3052″」の対処

2023 3/07

2021年8月18日 2023年3月7日

AccessVBAを使うと出るエラー「実行時エラー”3052″」の対処方法

エラー対処方法3選

Accessマクロでは簡単に組み直せないかなぁ？
更新データを小さくすることは出来ないのかなぁ？
トランザクションカウンターを０にする！

この順番で解決していくのが望ましい！

今回は「３．トランザクションカウンターを０にする！」に焦点を当てVBAを更新する。

Accessで実行時エラーが出るのは、そもそもデータチェックが甘い

これは作成者のエラーチェックがそもそも甘く、導入時に良くテストしてないから起こる。

言ってみればバグなんだ。が、私も昔からよくやるんだよｗ

一度でも対処した事があれば、結構苦労するから「頭の片隅に残るんだが…」

一度もやってないとなかなか上手く動かないまま「Accessはダメだぁ～～っ」て、

自分のスキルのなさを棚に上げてMicrosoftのせいにする。

簡単なデータ修正の仕方として、元データをもう少し小さくして（Selectして）

更新かければ良いので普通はSQL（選択クエリー）を工夫するだけで更新は可能となる。が、

私のように適当にホームページからコピペし、データ化している場合は利用する項目が

あまり使われていないと、発見が遅れ！気付いた時には全て修正するといったハメに陥り！

ん１０万件といったデータを、、、更新しなければいけなくなる😨

「実行時エラー”3052″」はトランザクションカウンターのオーバー

規定値：9500程度、VBAで処理する前にデータをセーブしておけば良いだけのことなので
Accessでロールバックできなくても良いのよねぇ～～

この9500を変更して大き目の数字を入れるといった変更でもできなくもないが、
競馬データを修正するとなると、１つのテーブルでも、ん百、ん十万データといった数字になり
この程度のことでレジストリを弄って、パソコンごとクラッシュなんて目も当てられんよね。

Accessでは勝手にトランザクション処理が動いていて、初期値9500件を超えると、3052エラーが発生するそうです。対処方法は、安易に最大値を増やすのではなく、定期的にコミットする事。
Google検索：「実行時エラー”3052″」

エラーでググったらすぐ出てきたので、これを利用すると簡単に直ったよ。

要はVBA記述内にトランザクションカウンターを０に戻す記述を入れるだけでOk！

ここから先は、
競馬データの種牡馬（父・母・母父）の名前の先頭に制御文字が入っているデータが複数あり
それを取り除くプログラムを作成した時の「実行時エラー”3052″」を記載する。

具体例があった方が分かりやすいので、下記にUWSC対象モジュールを記載しておく。

文字列から制御文字を取り除くVBAをググって入手

Function CleanChar(strData As String) As String
'引数の文字列から制御コードを除去した文字列を返す

  Dim strRet As String
  Dim strCurChar As String
  Dim I As Integer

  strRet = ""
  For I = 1 To Len(strData)
    strCurChar = Mid$(strData, I, 1)
    If Asc(strCurChar) < 0 Or Asc(strCurChar) >= 32 Then
      '漢字のAscの返り値はマイナスに留意
      strRet = strRet & strCurChar
    End If
  Next I

  CleanChar = strRet

End Function

これを利用して、父・母・母父のデータを修正するバッチを組むだけ！　が、

「実行時エラー”3052″」を回避しようと思い
Accessマクロを作成して上記「CleanChar」を関数として呼び出して処理すれば良いかな～と思っていたのだが…

どうにも上手く動かないので、
しぶしぶVBAで組むしかないと諦めエラー検索したら
トップにこのトランザクションカウンターのことが書かれていたので参考になった。

「DBEngine.BeginTrans」と「DBEngine.CommitTrans」

詳しくはココを見てくれたまえ～

DBEngine メソッド (DAO)

「実行時エラー”3052″」になったVBAモジュールサンプル

Function RKetou()

    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim myQuery As QueryDef
    Dim strSQL As String
    Dim WK_NM1 As String, WK_NM2 As String, WK_NM3 As String

    strSQL = "SELECT MS_DT.父, MS_DT.母, MS_DT.母父 FROM MS_DT;"

    'カレントデータベースを変数に代入する
    Set db = CurrentDb
    
    'レコードセットを開く

    Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
       
    RKetou = False
    If rst.RecordCount <= 0 Then Exit Function

        Do
            rst.Edit

            WK_NM1 = CleanChar(Trim$rst!父))
            WK_NM2 = CleanChar(Trim$(rst!母))
            WK_NM3 = CleanChar(Trim$(rst!母父))

            rst!父 = Trim$(WK_NM1)
            rst!母 = Trim$(WK_NM2)
            rst!母父 = Trim$(WK_NM3)
            
            rst.Update
            rst.MoveNext
            
        Loop Until rst.EOF = True
        
    rst.Close
    RKetou = True
End Function

最初のレコードを更新する前には BeginTrans メソッドを使用し、以降の更新が失敗した場合は Rollback メソッドを使用してすべての更新を元に戻すことができます。最後のレコードを正しく更新できたら CommitTrans メソッドを使用します。
DBEngine メソッド (DAO)　から抜粋

上記のとおり、Rollback メソッドを使う予定がなければ、9500件内でカウントを０にすれば良いだけなので
これをモジュール内に入れ込むだけになる。

修正後は下記参照。

「.BeginTrans」「 .CommitTrans 」を入れた修正モジュールサンプル

Function RKetou()

    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim myQuery As QueryDef
    Dim strSQL As String
    Dim WK_NM1 As String, WK_NM2 As String, WK_NM3 As String
    Dim cnt As Integer

    strSQL = "SELECT MS_DT.父, MS_DT.母, MS_DT.母父 FROM MS_DT;"

    'カレントデータベースを変数に代入する
    Set db = CurrentDb
    
    'レコードセットを開く

    Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
    
    cnt = 0
    DBEngine.BeginTrans
    
    RKetou = False
    If rst.RecordCount <= 0 Then Exit Function

        Do
            rst.Edit

            WK_NM1 = CleanChar(Trim$rst!父))
            WK_NM2 = CleanChar(Trim$(rst!母))
            WK_NM3 = CleanChar(Trim$(rst!母父))

            rst!父 = Trim$(WK_NM1)
            rst!母 = Trim$(WK_NM2)
            rst!母父 = Trim$(WK_NM3)
            
            rst.Update
            rst.MoveNext
            
            'トランザクションコミット処理
            cnt = cnt + 1
            If cnt = 5000 Then
                DBEngine.CommitTrans
                DBEngine.BeginTrans
                cnt = 0
            End If
        Loop Until rst.EOF = True
        
    DBEngine.CommitTrans
    rst.Close
    RKetou = True
End Function