Mictosoft Accessで1つのフォームから2つのテーブルの値を同時に更新・追加を行いたい

Question

はじめまして。

案件を登録するテーブル「T_案件」の連結フォームの「F_案件」があります。

登録ボタンを押した場合に、T_案件のレコード更新をさせていたのですが、別テーブルの「T_履歴情報」にも情報を更新・追加をさせたいと考えております。

以下の様なコードを作成したのですが、

実行時エラー'3034';

コミットまたはロールバックを実行するには、BeginTransメソッドを使用してください。

のエラーが出ます。

解決策についてご教授頂けますと幸甚です。

Private Sub 登録_Click()

  Result = MsgBox("入力内容を登録しますか？", vbYesNo + vbDefaultButton1 + vbQuestion, "登録確認")
    If Result = vbYes Then
    Me.Requery
      Dim db As DAO.Database
  Set db = CurrentDb

  Dim intTranCount As Integer
  Dim rs1 As DAO.Recordset
  Dim rs2 As DAO.Recordset
  Set rs1 = db.OpenRecordset("T_案件")
  Set rs2 = db.OpenRecordset("T_履歴情報")

  intTranCount = 0
  DBEngine.BeginTrans

  Do Until rs1.EOF
           rs1.Edit
      rs1![顧客名] = Me!顧客名
      rs1![発生日] = Me!発生日
      rs1![媒体] = Me!媒体
      rs1![工事種別] = Me!工事種別
      rs1![工事内容] = Me!工事内容
      rs1![状況] = Me!状況
      rs1![契約日] = Me!契約日
      rs1![契約額] = Me!契約額
      rs1![契約NET] = Me!契約NET
      rs1![完工日] = Me!完工日
      rs1![完工NET] = Me!完工NET
      rs1![契約月] = Me!契約月
      rs1![完工月] = Me!完工月
      rs1![契約期] = Me!契約期
      rs1![完工期] = Me!完工期
      rs1![備考欄] = Me!備考欄
      If rs1![案件ID] = Me!案件ID Then

           rs1.Update

        Else

           rs1.CancelUpdate

        End If

           rs1.MoveNext

        Loop
        Set rs1 = Nothing
        Set db = Nothing


  Do Until rs2.EOF
           rs2.Edit

      rs2![顧客名] = Me!顧客名
      rs2![営業日] = Me!発生日
      rs2![販促種類] = "工事履歴"
      rs2![件名] = Me!工事内容
      rs2![担当者] = Me!担当者
   If rs2![案件ID] = Me!案件ID Then
      rs2.Update

        Else

           rs2.AddNew
      rs2![案件ID] = Me!案件ID
      rs2![顧客名] = Me!顧客名
      rs2![営業日] = Me!発生日
      rs2![販促種類] = "工事履歴"
      rs2![件名] = Me!工事内容
      rs2![担当者] = Me!担当者
      rs2.Update

        End If

           rs2.MoveNext
      'トランザクションMAX制御
       intTranCount = intTranCount + 1
    If intTranCount = 5000 Then
       DBEngine.CommitTrans　　　←ここがエラーになっている？（黄色く表示されてます）
       DBEngine.BeginTrans
       intTranCount = 0
    End If

        Loop

       DBEngine.CommitTrans

        Set rs2 = Nothing
        Set db = Nothing

    If Result = vbNo Then
    Cancel = True
    End If
    End If
    DoCmd.OpenForm "F_Main"
    DoCmd.Close acForm, "F_案件"

End Sub

 以上、宜しくお願い申し上げます。                                                                                                                                                                                    

Answer 1

エラーとしては、トランザクション状態ではない時にCommitTransを実行しようとしているからですが、掲載されたコードからはBeginTransはCommitTransの前に必ず実行されていると思います。
そうなると他の原因になりますが、その前にいくつか疑問があります。まず、
Do Until rs2.EOF
           rs2.Edit
のループのなかで、AddNewをされていますが、これだと案件IDが１件目に見つからないと必ずAddNewされるように思います。といいますか、案件IDが見つかるまでAddNewされ続けるように思います。通常、ループの中でそのコレクションが変化する方法は、混乱の元になりますのであまり行いません。
よって、rs1も含めて、rs2共にループによる処理ではなく、FindFirstで目的のレコードを見つけて更新するのが良いのではないかと思います。

トランザクションのエラーの原因ははっきりわかりませんが、何らかのエラーが発生し、トランザクションがロールバックした結果かもしれません。そのため、ループにおけるロジックの見直しをまずは提案してみました。

---

★良い回答には回答済みマークを付けよう！ MVP - .NET 　http://d.hatena.ne.jp/trapemiya/

Answer 2

ご回答、ありがとうございます！

Do Until rs2.EOF
           rs2.Edit
のループのなかで、AddNewをされていますが、これだと案件IDが１件目に見つからないと必ずAddNewされるように思います。といいますか、案件IDが見つかるまでAddNewされ続けるように思います。通常、ループの中でそのコレクションが変化する方法は、混乱の元になりますのであまり行いません。
よって、rs1も含めて、rs2共にループによる処理ではなく、FindFirstで目的のレコードを見つけて更新するのが良いのではないかと思います。

ループにおけるロジックの見直しをしたいと思うのですが、FindFirstについて知識が乏しく、もし宜しければサンプルコードをご教授頂けると有り難いです。

Answer 3

FindFirstを用いて更新する例は以下にあります。

EditメソッドとUpdateメソッドの使い方
http://www.happy2-island.com/access/gogo03/capter00209.shtml

さて、私も記憶が飛んでいたのですが、レコードを検索するメソッドとして、Seekというのもあります。
こちらはテーブルタイプのレコードセットに対して検索を行うことができます。
今回は、テーブルを直接更新されるようですし、可能であればSeekを使う方が良さそうです。
Seekはインデックスを利用しますので、FirndFirstよりもパフォーマンスが良くなります。
Seekを使って更新する例が以下にあります。

Access VBA DAOでレコードを更新する方法。
http://vba.officehp.com/article/99302086.html

FindFirstとSeekは以下のページを読まれると違いがよくわかると思います。

Recordset.Seek メソッド (DAO)
https://msdn.microsoft.com/ja-jp/library/office/ff836416.aspx

Recordset.FindFirst メソッド (DAO)
https://msdn.microsoft.com/ja-jp/library/office/ff194787.aspx

---

★良い回答には回答済みマークを付けよう！ MVP - .NET 　http://d.hatena.ne.jp/trapemiya/

Answer 4

ご回答、ありがとうございます。

Seekを使用してみようと思いリンクのページを参考にコードを作成してみたのですが、INDEXの部分で「この操作はこのタイプのオブジェクトには使用できません」とエラーが出てしまいます。

修正してみたコードは以下の通りです↓

Private Sub 登録_Click()
  Result = MsgBox("入力内容を登録しますか？", vbYesNo + vbDefaultButton1 + vbQuestion, "登録確認")
    If Result = vbYes Then
    Me.Requery
      Dim db As DAO.Database
  Set db = CurrentDb
        
  Dim rs1 As DAO.Recordset
  Dim rs2 As DAO.Recordset
  Set rs1 = db.OpenRecordset("T_案件")
  Set rs2 = db.OpenRecordset("T_履歴情報")
    
  Do Until rs1.EOF
           rs1.Edit
      rs1![顧客名] = Me!顧客名
      rs1![発生日] = Me!発生日
      rs1![媒体] = Me!媒体
      rs1![工事種別] = Me!工事種別
      rs1![工事内容] = Me!工事内容
      rs1![状況] = Me!状況
      rs1![契約日] = Me!契約日
      rs1![契約額] = Me!契約額
      rs1![契約NET] = Me!契約NET
      rs1![完工日] = Me!完工日
      rs1![完工NET] = Me!完工NET
      rs1![契約月] = Me!契約月
      rs1![完工月] = Me!完工月
      rs1![契約期] = Me!契約期
      rs1![完工期] = Me!完工期
      rs1![備考欄] = Me!備考欄
      If rs1![案件ID] = Me!案件ID Then
           
           rs1.Update
                         
        Else
                    
           rs1.CancelUpdate
           
        End If
        
           rs1.MoveNext
  
        Loop
        Set rs1 = Nothing
        Set db = Nothing
          
  rs2.Index = "Primarykey"　←ここでエラーが出てます
  rs2.Seek "=", Me!案件ID

  If rs.NoMatch Then
        
        rs2.AddNew
      
      rs2![案件ID] = Me!案件ID
      rs2![顧客名] = Me!顧客名
      rs2![営業日] = Me!発生日
      rs2![販促種類] = "工事履歴"
      rs2![件名] = Me!工事内容
      rs2![担当者] = Me!担当者
      rs2.Update
      
        Else
      
      rs2![顧客名] = Me!顧客名
      rs2![営業日] = Me!発生日
      rs2![販促種類] = "工事履歴"
      rs2![件名] = Me!工事内容
      rs2![担当者] = Me!担当者
      rs2.Update
                         
        End If
        
        Set rs2 = Nothing
        Set db = Nothing
      
    If Result = vbNo Then
    Cancel = True
    End If
    End If
    DoCmd.OpenForm "F_Main"
    DoCmd.Close acForm, "F_案件"
End Sub

度々申し訳ございませんが、アドバイスを頂けると有り難いです。

Answer 5

RecordSetはテーブルタイプで開かれていると思いますので、おそらく構文の間違いだと思われます。

＞rs2.Index = "Primarykey"　←ここでエラーが出てます

このPryimaryKeyというのは別名、主キーと呼ばれるもので、実際のテーブルの主キーになります。
例えば、T_案件の主キー（PrimaryKey）が案件IDの場合、
rs2.Index = "案件ID"
となります。
もし、T_案件に主キーがなく、案件IDを主キーにして良いのであれば、案件IDを主キーとして設定して下さい。

---

★良い回答には回答済みマークを付けよう！ MVP - .NET 　http://d.hatena.ne.jp/trapemiya/

Answer 6

度々のご回答ありがとうございます！

＞もし、T_案件に主キーがなく、案件IDを主キーにして良いのであれば、案件IDを主キーとして設定して下さい。

主キーは別のものが設定されており、案件IDを主キーとする事が出来ません。

（案件IDは重複がありますので。）

この場合、Seekは使用できないのでしょうか？

本当に何度も申し訳ございませんが、アドバイス頂けますと幸甚です。

Answer 7

まず、ごめんなさい。

＞rs2.Index = "Primarykey"　←ここでエラーが出てます

についての私の前の発言は嘘だったようです。エラーということでてっきり実際の主キーの列を指定する必要があるかと思ったのですが、そうではなく、どうも"PrimaryKey"というのは予約語のようで、そのテーブルの主キーを表すようです。
エラーになったのは、ひょっとしてT_履歴情報に主キーがないからでしょうか？

さて、案件IDがユニークでないとなると、Seekは使えないかもしれません。Seekはユニークではないキーで検索した場合、最初に見つかったレコードをカレントレコードにするとMSDNに記述がありますが、その後、次の条件を満たすレコードに移動する方法を見つけることができなかったからです。
ただ、MoveNextは現在のインデックスに沿って移動するそうなので、Seekで最初のレコードを見つけた後に、MoveNextを行い、EOFになるか、案件IDが異なるかまでMoveNextするとよさそうな気もします。（インデックスが昇順に並んでいるという前提ですが、その記述を見つけることができませんでした）

よって、案件IDで絞り込んだクエリからダイナセットタイプのレコードセットを得て、そこに含まれる全てのレコードに対して更新すれば良いと思います。例としては、以下のページの「クエリ(SQL)を使ったダイナセット･タイプのRecordset」が参考になると思います。

Ｍｉｃｒｏｓｏｆｔ　Ａｃｃｅｓｓ２００３
http://sennin.image.coocan.jp/access/access678/access8.htm

しかし、せっかくSQLが使えるので、Where条件に案件IDをセットして、Update文を一つ実行すればそれで済みそうな気がします。基本は、VBAのコードではなく、SQLを使ってデーターベース側で処理を実行させるように考えることが最初です。それでどうしてもできなければ、VBAでレコードセットを読み込んでどうにかするという流れです。

＃今、テストできる環境がなく、正確なことが言えずにごめんなさい。

---

★良い回答には回答済みマークを付けよう！ MVP - .NET 　http://d.hatena.ne.jp/trapemiya/

Answer 8

trapemiya様

何度もご丁寧なご教授を賜り誠にありがとうございました。

結局、FindFirstを使って処理してみる事にしたところ上手く行きました。

ご参考までに最終的なコードは以下の通りです↓

Private Sub 登録_Click()
  Result = MsgBox("入力内容を登録しますか？", vbYesNo + vbDefaultButton1 + vbQuestion, "登録確認")
    If Result = vbYes Then
    Me.Requery
      Dim db As DAO.Database
  Set db = CurrentDb
        
  Dim rs1 As DAO.Recordset
  Dim rs2 As DAO.Recordset
  Set rs1 = db.OpenRecordset("T_案件")
  Set rs2 = db.OpenRecordset("T_履歴情報")
    
  Do Until rs1.EOF
           rs1.Edit
      rs1![顧客名] = Me!顧客名
      rs1![発生日] = Me!発生日
      rs1![媒体] = Me!媒体
      rs1![工事種別] = Me!工事種別
      rs1![工事内容] = Me!工事内容
      rs1![状況] = Me!状況
      rs1![契約日] = Me!契約日
      rs1![契約額] = Me!契約額
      rs1![契約NET] = Me!契約NET
      rs1![完工日] = Me!完工日
      rs1![完工NET] = Me!完工NET
      rs1![契約月] = Me!契約月
      rs1![完工月] = Me!完工月
      rs1![契約期] = Me!契約期
      rs1![完工期] = Me!完工期
      rs1![備考欄] = Me!備考欄
      If rs1![案件ID] = Me!案件ID Then
           
           rs1.Update
                         
        Else
                    
           rs1.CancelUpdate
           
        End If
        
           rs1.MoveNext
  
        Loop
        Set rs1 = Nothing
        Set db = Nothing
          
  rs2.FindFirst "案件ID='" & Me.案件ID & "'"

  If rs2.NoMatch Then
        
        rs2.AddNew
      
      rs2![案件ID] = Me!案件ID
      rs2![顧客名] = Me!顧客名
      rs2![営業日] = Me!発生日
      rs2![販促種類] = "工事履歴"
      rs2![件名] = Me!工事内容
      rs2![担当者] = Me!担当者
      rs2.Update
      
        Else
        
        rs2.Edit
        
      rs2![顧客名] = Me!顧客名
      rs2![営業日] = Me!発生日
      rs2![販促種類] = "工事履歴"
      rs2![件名] = Me!工事内容
      rs2![担当者] = Me!担当者
      rs2.Update
                         
        End If
        
        Set rs2 = Nothing
        Set db = Nothing
      
    If Result = vbNo Then
    Cancel = True
    End If
    End If
    DoCmd.OpenForm "F_Main"
    DoCmd.Close acForm, "F_案件"
End Sub

＞しかし、せっかくSQLが使えるので、Where条件に案件IDをセットして、Update文を一つ実行すればそれで済みそうな気がします。基本は、VBAのコードではなく、SQLを使ってデーターベース側で処理を実行させるように考えることが最初です。それでどうしてもできなければ、VBAでレコードセットを読み込んでどうにかするという流れです。

この基本的な事を理解しておりませんでした。。。

VBAでレコードセットを読み込んでどうにかすることしか頭に無かったので、SQLをもっときちんと使いこなせるように勉強して行きます。

問題解決まで長々とお付き合い頂きまして本当にありがとうございました。