• ベストアンサー

Transactionで待機状態になりません

Access2003 Win-XPです。 ネットワーク上にmdbを置いて、複数ユーザーで共用して使用していますが、マルチユーザー環境での制御が出来ません。 具体的には、ある人(Aさん)がBeginTransからCommitする間に別の人(Bさん)が同じデータを更新しようとしてBeginTransをスルーしてしまいます。 待機状態になりません。 (いわゆるLockの概念とは違うのでしょうか?) 確かに、Bさんの更新はテーブルへ反映されることはないのですが、何もなかったようにスルーして処理が進んでしまいます。 エラーにもならないのでハンドリングしようがないです。 これでは、Bさんはあたかも自分の更新が成功したかのように錯覚をしてしまいます。 分厚い壁にぶち当たり、何をどうしたらよいのかまったくわかりません。 どなたかご教授ください。 具体的なコーディングは下記です。 Dim ret_value As Variant Dim wsp As Workspace Dim dbs As Database Set wsp = DBEngine.Workspaces(0) Set dbs = CurrentDb wsp.BeginTrans  dbs.Execute "update [tm_memory_card] set [機種] = '" & Me.[機    種] & "'" dbs.Close ret_value = MsgBox("Commit ?", vbYesNo) If ret_value = vbYes Then wsp.CommitTrans Me.Requery Else wsp.Rollback End If テストしやすいように、Commit直前で処理を止められるようにしました。

質問者が選んだベストアンサー

  • ベストアンサー
  • nora1962
  • ベストアンサー率60% (431/717)
回答No.2

dbs.Execute "update [tm_memory_card] set [機種] = '" & Me.[機    種] & "'", dbFailOnError でやってみてください。先行トランザクションがあればエラーになるはずです。

onakichi
質問者

お礼

エラーコード=3218でハンドリングできました! ありがとうございました。

その他の回答 (1)

  • nda23
  • ベストアンサー率54% (777/1415)
回答No.1

Executeの場合、dbSeeChanges などのオプションを付けないと、エラーに ならないのでは?トランザクション管理するなら、レコードセットか DoCmdのRunSQLメソッドを使うべきではないでしょうか。

onakichi
質問者

お礼

dbseechangesを付けてハンドリングできました。 ありがとうございました。

onakichi
質問者

補足

トランザクション管理する場合、Ececuteを使わなければダメだと言われたことがあったので、Executeを使ってみたのですが、なぜ、RunSQLを使かう必要があるのか教えていただけないでしょうか。

関連するQ&A

  • レコード単位にトランザクションかけられる?

    Access2003 Win-XP です。 下記コーディングで現象は・・・ ・2つのPCで同じレコードを編集すると、あとから編集する人は待機中になる。 ・しかしながら、同じテーブルで最初にレコード編集中の人がいたとき、別PCの人が別レコードを編集することは可能で待機することはない(これは正常)。そして正常に更新されたかのように終了する。しかしながら、更新はされていない。   (更新されないのにエラーハンドリングできない) これはいったいどういうことでしょうか? 何か対策はないでしょうか? Dim ret_value As Variant Dim wsp As Workspace Dim dbs As Database Dim rsA Set wsp = DBEngine.Workspaces(0) Set dbs = CurrentDb wsp.BeginTrans Set rsA = dbs.OpenRecordset("在籍表", dbOpenDynaset, dbSeeChanges, dbPessimistic) Do Until rsA.EOF If rsA.[出席番号] = Me.[出席番号] Then rsA.Edit rsA.[氏名] = Me.[氏名] rsA.Update rsA.MoveLast End If rsA.MoveNext Loop rsA.Close ret_value = MsgBox("Commit ?", vbYesNo) If ret_value = vbYes Then wsp.CommitTrans Me.Requery Else wsp.Rollback End If Exit_コマンド34_Click: Set wsp = Nothing Exit Sub Err_コマンド34_Click: MsgBox Err.Description Resume Exit_コマンド34_Click  

  • VB5+SQL2000での ** TRANSACTIONについて(ADO)

    環境:VB5(SP3)+SQL2000(SP1) VBで、BEGIN TRANSACTIONを定義し、その後更新用DBを更新する前に、ストアドプロシージャを利用せずDBを検索した場合、問題無く更新用DBへの更新に対して(ROLLBACK/COMMIT) TRANSACTION が効くのですが、ストアドプロシージャで検索した場合、(ROLLBACK) TRANSACTION が効きません。 分かりづらいですがサンプルを記します。 Function Test() Dim MyRs As New ADODB.Recordset Dim MyRs2 As New ADODB.Recordset : MyDB.Execute "BEGIN TRANSACTION TEST999",,adCmdText+adExecuteNoRecords : '(A)不具合未発生パターン 'レコードセットを開く 'このように、レコードセットを作成した場合問題なし。 MyRs.Open "SELECT * FROM TESTDB..テスト",MyDB,adOpenStatic '(B)不具合発生パターン 'ただし、上のSELECT文をストアドプロシージャで開いた場合、ROLLBACKが効かない 'レコードセットを開く(正常に(ROLLBACK)TRANSACTIONが動作せず、UpDate時にCommitしている) 'MyRs.Open "TESTDB..TEST001",MyDB,adOpenStatic : MyRs2.Open "SELECT * FROM TESTDB..更新テスト",MyDB,adOpenKeyset,adLockPessimistic If Err <> 0 Then 'Error処理 End If If MyRs2.EOF Then MyRs2.AddNew MyRs2![FLD1] = MyRs2![FLD1A] Else MyRs2![FLD1] = "TEST" End If MyRs2.UpDate 'ここは正常終了。(Err = 0) 'テスト用にエラー設定 Err = 1 if Err <> 0 then '(B)不具合発生パターンの場合、ROLLBACK をしても、DBに登録されてしまう。 MyDB.Execute "ROLLBACK TRANSACTION TEST999",,adCmdText+adExecuteNoRecords Exit Function End If MyRs.Close MyRs2.Close SmileDB.Execute "COMMIT TRANSACTION TEST999",,adCmdText+adExecuteNoRecords End Function

  • アクセスのVBAでテキストデータのリンクを更新したいのですが

    コードは以下ですが、リンクの更新がうまくいかず更新されずに終了 してしまいます。 Function RefreshLinks(strFileName As String) As Boolean '指定されたデータベースへのリンクを更新します。更新に成功した場合は、True を返します。 Dim dbs As Database Dim intCount As Integer Dim tdf As TableDef 'データベースの全てのテーブルをループします。 Set dbs = CurrentDb For intCount = 0 To dbs.TableDefs.Count - 1 Set tdf = dbs.TableDefs(intCount) 'tdf.connectがある場合、それはリンクテーブルです。 If Len(tdf.Connect) > 0 Then tdf.Connect = "text;databese=" & strFileName Err = 0 On Error Resume Next tdf.RefreshLink 'テーブルのリンクを更新します。 If Err <> 0 Then RefreshLinks = False Exit Function End If End If Next intCount RefreshLinks = True 'リンクの更新が完了しました。 End Function

  • AccessVBA トランザクション処理について。

    AccessVBAにてコードを作成する際に、 下記トランザクション処理のコードを書くとデータ喪失予防になると 聞きました。(エラーが起きたときには、処理前に戻ると。) この処理は、delete~insertのような処理でないと有効にならないのでしょうか?どんな処理でも有効ですか? Dim Wrk As workspace Dim blnFlag As Boolean Set Wrk = DBEngine.Workspaces(0) Wrk.BeginTrans blnFlag = True ***************************** delete ~insert (update) ***************************** Wrk.CommitTrans blnFlag = False Set Wrk = Nothing Err: If blnFlag = True Then Wrk.Rollback End If

  • [性能改善]AccessのDBに大量のデータをUpdateする場合の性能対策について

    初めまして。 早速質問なのですが、VB(6.0)でmdb(Access2000)のDBを更新する処理を作りました。 DAOを用いて(初めて使います)以下のような構文を作ったのですが、 性能がぱっとしません。 何か下記のソースをいじることで性能が改善するような手立てはありませんでしょうか? ---------------------------------------------------------------------- Sub Main()      Dim cDaoDB    As DAO.Database      Dim cDaoWS    As Workspace      Dim cColUpdate  As Collection      Dim varColItem  As Variant      Dim lngCnt    As Long      Set cDaoWS = DBEngine.Workspaces(0)      Set cDaoDB = mDaoWS.OpenDatabase("C:\TEST.mdb")      'コレクションにデータをaddする処理は省略しています      cColUpdate.add            With cDaoDB           cDaoWS.BeginTrans           'cColUpdateコレクションには10万件ほどのSQL構文(Update構文)が格納されています           '10万回ほど繰り返し処理します           For Each varColItem In cColUpdate                lngCnt = lngCnt + 1                If lngCnt > 1000 Then                     'データ量が多いため1000件ごとにコミットしています                     cDaoWS.CommitTrans                     cDaoWS.BeginTrans                     lngCnt = 0                End If                strErrSQL = varColItem                'Update処理が繰り返し流れます。                .Execute varColItem           Next           .Close           cDaoWS.Close      End With      Set cDaoDB = Nothing      Set cDaoWS = Nothing End Sub ---------------------------------------------------------------------- よろしくお願いします。

  • 検索マクロ

    下記のマクロは、検索文字でシートを検索し、そのセルアドレス情報を シートを追加して表示する機能ですが、BOOK全体に検索し、シート名を含めて表示するには、xxxxのところをどのように変更すればいいか。よろしくお願いします。 Sub kennsaku_Macro1() Dim ret Dim r As Range Dim adr As String Dim cnt As Long Dim psw As Boolean Dim mySht, adSht, ws As Worksheet Set mySht = ActiveSheet ret = Application.InputBox("検索文字列を入力してください") If TypeName(ret) <> "Boolean" Then With mySht.Cells Set r = .Find(ret, LookIn:=xlValues, lookat:=xlPart) If Not r Is Nothing Then adr = r.Address cnt = 2 '2行目から表示 xxxxxxxxxxxxx For Each ws In Worksheets If ws.Name = "検索結果" & ret Then psw = True Exit For End If Next ws If psw Then Set adSht = ws adSht.Cells.ClearContents Else Set adSht = Worksheets.Add adSht.Name = "検索結果" & ret End If adSht.Cells(cnt, 1).Value = r.Value adSht.Cells(cnt, 2).Value = xxxx 'シート名 adSht.Cells(cnt, 3).Value = adr Do Set r = .FindNext(r) If r.Address = adr Then Exit Do Else cnt = cnt + 1 adSht.Cells(cnt, 1).Value = r.Value adSht.Cells(cnt, 2).Value = xxxx 'シート名 adSht.Cells(cnt, 3).Value = r.Address End If Loop End If End With End If adSht.Cells(1, 1).Value = "項目" adSht.Cells(1, 2).Value = "シート名" adSht.Cells(1, 3).Value = "セルアドレス" mySht.Activate End Sub

  • Access2007 サブフォームのレコードを一括印刷する方法

    お世話になっております。 サブフォームは帳票型になっており、下記で表示されている全レコードのチェックが入ります。 これと平行して、各レコードを印刷したいのですが、カーソルがあるレコードのみがレコードの数だけ印刷されてしまいます。 これを各レコードごとに印刷したいと思います。 Dim dbs As Database Dim rst As Recordset Dim strSQL As String Set dbs = CurrentDb Set rst = Me.RecordsetClone With rst If .RecordCount > 0 Then .MoveFirst Do Until .EOF .Edit !チェック = True DoCmd.OpenReport "印刷", acNormal, , "コード=" & Me.コード .Update .MoveNext Loop End If .Close End With ご教授いただければ幸いです。よろしくお願いいたします。

  • テキストボックスに入れた内容をAccessのテーブルに登録する方法を教えてください。

    はじめまして。 VBでフォームに作ったテキストボックス(text1、text2、text3)に値を入れてコマンドボタンを押したらAccessのテーブルに値を登録できるようにしたいのですが上手くいきません。自分で調べながらコーディングしたのですが上手く動かずどうすれば動くのかVBのコーディングを教えていただきたいです。よろしくお願いします。 [Accessのファイル名] db1.mdb [db1.mdbのテーブル名] ListName [ListNameの各項目] 名前、住所、生年月日 [VBのフォーム] text1.textbox、text2.textbox、text3.textbox Add.command [コーディングの内容] Microsoft DAO 3.6 Object Library参照設定 Private Sub Add_Click() Dim strSQL As String Dim dbName As String Dim dbs As DAO.Database Dim myset As DAO.Recordset Dim ws As DAO.Workspace Set ws = DBEngine.Workspaces(0) Set dbs = ws.OpenDatabase("C:\db1.mdb") If Dir("C:\db1.mdb") <> "" Then strSQL = "INSERT INTO Listname (名前,生年月日, _ 住所) values(text1.text, text2.text, text3.text)" Me.AutoRedraw = True Set myset = dbs.OpenRecordset(strSQL) End If End Sub ※無効な処理です。というエラーが出ます。

  • 子画面を読んだ後親画面のRecordsetClon

    同じレコードソースを持つ帳票フォームAとポップアップ画面Bがあり 新規作成ボタンイベントで、Aからで新規入力用のB画面を acAddNew, acDialogで開き 新規レーコドを追加する作業をして B画面の保存ボタンを押すことでしてレコードを保存しています。 ◆B画面の保存ボタンの処理 Private Sub cmd保存_Click()   '保存処理   Dim i As Long   Dim NewKey As Long   Dim SQL As String   Dim lngCurrentRec As Long      If Me.Dirty = True Then     Ret = MsgBox("入力したデータを保存しますか。", vbQuestion + vbOKCancel)     If Ret = vbCancel Then       cmd取消_Click       GoTo exitH     End If     Set Me.ClsDao_ = New ClsDao     SQL = "Select final_value, [更新日時] from T95ID管理表 "     SQL = SQL & "where "     SQL = SQL & " ID_Name = '作業記録ID';"          NewKey = Me.ClsDao_.SelectID(SQL)     Me.作業記録ID.Value = NewKey          Me.BeforeUpdate = ""     DoCmd.RunCommand acCmdSaveRecord          '採番テーブルに新しいNoで更新をする     ClsDao.UpdateID NewKey     modPub.lngNewRecID = NewKey 'Global変数に新しいID NOをセット(親画面で取得するため)     Set ClsDao = Nothing          BeforeUpdate = "[イベント プロシージャ]"   '  Me.Visible = False     DoCmd.Close   End If End Sub ◆B画面の保存ボタンの処理終わり    その後、呼出元のB画面を開くイベントの処理を継続し A画面を更新し、新規入力されたレコードを選択する処理をしています。 問題は、まず1回目には、新規作成ボタンを押して新規データを登録し A画面でその新規レコードを選択することが1回目は可能で 同じ事を2回目すると、 ※実行時エラー'7951':  RecordSetCloneプロパティに対する不適切な参照を含む式を入力しました。 というエラーが出ます。 その時の画面は、複数行あったのが一レコードだけになってしまい、 各項目のTextboxは、「#Name?」が表示されています。 デバッグボタンを押すと 以下のソースの「Set Rec = Me.RecordsetClone」で止まります。 この解決方法を教えて下さい。 ◆A画面の新規作成ボタンのソースの内容開始 Private Sub cmdNewRec_Click()   Dim ClsDao As ClsDao   Dim SQL As String   Dim NewFm As Form   Dim Rec As Recordset   Dim NewNo As Long   Dim MyFm As Form   Dim StrRecSource As String      Set MyFm = Me.Form    StrRecSource = Me.RecordSource      DoCmd.OpenForm "FXX作業記録(NewEntry_連結版)", acNormal, , , acFormAdd, acDialog      If modPub.lngNewRecID > 0 Then     NewNo = modPub.lngNewRecID     Me.RecordSource = StrRecSource     Me.Requery     Set Rec = Me.RecordsetClone <===ここでエラー     Rec.FindFirst "作業記録ID = " & NewNo     If Rec.NoMatch = False Then '      Me.CurrentRecord = Rec.AbsolutePosition       DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, Rec.AbsolutePosition + 1       Rec.Close       Set Rec = Nothing     End If   End If End Sub ◆A画面の新規作成ボタンのソースの内容終了

  • エクセルVBA

    A列を基準にBC列が空白ならAの数値を入れて、A>BならB列を更新、A<CならC列を更新 A列が数値以外ならその行をスキップ、という処理をしたいのですが Option Explicit Dim A As Range, B As Range, C As Range Dim i As Long Sub test() For i = 1 To 10 Set A = Cells(i, 1) Set B = A.Offset(0, 1) Set C = A.Offset(0, 2) If IsNumeric(A) Then Else Exit Sub End If If B.Value = "" Then B.Value = A.Value If C.Value = "" Then C.Value = A.Value If A.Value > B.Value Then B.Value = A.Value If A.Value < C.Value Then C.Value = A.Value Next i End Sub とすると数値以外の行の時点で停止してしまいます。 その行を飛ばして次の行に進むにはどうしたらいいのでしょうか?