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

  • 質問

  • はじめまして。

    案件を登録するテーブル「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

     以上、宜しくお願い申し上げます。                                                                                                                                                                                    
    2015年12月29日 4:29

回答

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

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


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

    • 回答としてマーク RHP227 2015年12月30日 8:41
    2015年12月29日 7:16
    モデレータ
  • 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/

    • 回答としてマーク RHP227 2015年12月30日 8:42
    2015年12月29日 16:23
    モデレータ
  • RecordSetはテーブルタイプで開かれていると思いますので、おそらく構文の間違いだと思われます。

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

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


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

    • 回答としてマーク RHP227 2015年12月30日 14:07
    2015年12月30日 10:27
    モデレータ
  • まず、ごめんなさい。

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

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

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

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

    Microsoft Access2003
    http://sennin.image.coocan.jp/access/access678/access8.htm

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

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


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

    • 回答としてマーク RHP227 2015年12月30日 17:06
    2015年12月30日 16:35
    モデレータ

すべての返信

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

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


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

    • 回答としてマーク RHP227 2015年12月30日 8:41
    2015年12月29日 7:16
    モデレータ
  • ご回答、ありがとうございます!

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

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

    2015年12月29日 14:57
  • 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/

    • 回答としてマーク RHP227 2015年12月30日 8:42
    2015年12月29日 16:23
    モデレータ
  • ご回答、ありがとうございます。

    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

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

    2015年12月30日 8:41
  • RecordSetはテーブルタイプで開かれていると思いますので、おそらく構文の間違いだと思われます。

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

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


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

    • 回答としてマーク RHP227 2015年12月30日 14:07
    2015年12月30日 10:27
    モデレータ
  • 度々のご回答ありがとうございます!

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

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

    (案件IDは重複がありますので。)

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

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

    2015年12月30日 14:11
  • まず、ごめんなさい。

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

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

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

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

    Microsoft Access2003
    http://sennin.image.coocan.jp/access/access678/access8.htm

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

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


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

    • 回答としてマーク RHP227 2015年12月30日 17:06
    2015年12月30日 16:35
    モデレータ
  • 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をもっときちんと使いこなせるように勉強して行きます。

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

    2015年12月30日 17:43