次の方法で共有

VBA の Recordset オブジェクトで共有データをロックする

  • [アーティクル]
Microsoft Office 2000/Visual Basic プログラマーズ ガイド   

連結フォームでマルチユーザー ソリューションを作成する場合は、VBA プロシージャのような柔軟性はありません。ロック プロシージャを記述し、非連結フォームから実行すると、ソリューションに最も適したロック方法でユーザー間の競合を処理できますが、これは、連結フォームからは不可能です。

ロック レベル

Recordset オブジェクトでは、次の 4 つのレベルでデータをロックします。

  • 排他モード データベース全体を他のユーザーが使えないようにし、制限レベルが最も高くなります。

  • レコードセット ロック Recordset オブジェクトのテーブルをロックします。

  • ページ レベル ロック 編集中のデータが保存されている 4096 バイト (4K) のページ全体をロックします。

  • レコード レベル ロック 現在編集中のレコードのみをロックします。

    メモ   [ツール] メニューから [オプション] ダイアログ ボックスを開いて [詳細] タブ にある [レコード レベルでロックして開く] 設定を使用してデータベースを開き、ページ レベルとレコード レベルのどちらでレコードをロックするかを指定します。ADO コードから Connection オブジェクトのプロバイダ特定の Jet OLEDB:Database Locking Mode プロパティを設定、または Recordset オブジェクトのプロバイダ特定の Jet OLEDB:Locking Granularity プロパティを設定して、ページ レベルまたはレコード レベルのロックを制御することもできます。詳細は、この章の「ページ レベル ロックとレコード レベル ロック」を参照してください。

ソリューションにおけるオブジェクトのロック レベルは、必要となる同時実行レベルで判断してください。同時実行により、同じデータベースへアクセスする複数のトランザクションが同時に可能となります。たとえば、多くのユーザーが頻繁にオブジェクトを使用できるようにする場合、高度同時実行戦略により、最も制限レベルの低いページ レベルまたはレコード レベルのロック使用を監視します。ソリューションで、データベースのほとんど、またはすべてのデータへアクセスできるようにする場合、排他モードを使用し、ソリューションのみでデータベースを開いてほかのユーザーと共有できないようにします。

4 つのロック レベルの組み合わせは相互排除ではありません。多くのマルチユーザー ソリューションでは、任意のレベルを各時点で使用できます。たとえば、多くの受注オペレータが同時にデータへアクセスできる注文入力システムでは、ページ レベル ロックまたはレコード レベル ロックを使用して Orders テーブルのデータをロックし、その日の営業終了時にはレコードセット ロックでサマリ テーブルをロックしてサマリ データでテーブルを更新します。最後に、毎晩、排他モードでデータベース全体をロックしてコンパクトにします。

排他モードの使用方法

排他モードは、データのロック方法の中では最も制限レベルが高いもので、ほかのすべてのユーザーはデータベースを開くことができず、データベース内のデータへアクセスできなくなります。このモードは、作業の修正やコンパクト化などのデータベースの管理面における変更、またはデータベースのデザインの変更などの大規模な変更を行う際に便利です。

通常、ユーザーが 1 人の状態でデータベースにアクセスする場合は、排他モードで開きます。Jet データベース エンジンではオブジェクトのロック/ロック解除や、キャッシュを更新する必要がないため、排他モードを使用すると高いパフォーマンスが期待できます。複数ユーザーでデータベースを開く場合は、ほかのユーザーがデータベースを開けなくなるため、排他モードは使用しないでください。ソリューションのデータを共有する場合は、ユーザーが排他モードでデータベースを開いていないことを確認してください。Access の保護機能を使用すると、ほとんどのユーザーの排他モードで開く権限を拒否できます。データベース管理者は、データベースのコンパクト化、修正などの作業を行うため、排他モードで開く権限を持っている必要があります。権限設定の詳細については、第 18 章「Access データベースにセキュリティを設定する」を参照してください。

コードを使用し、排他モードでデータベースを開くことができます。ADO を使用している場合は、データベースを開く際に使用する Connection オブジェクトの Mode プロパティを adModeShareExclusive に設定してください。次のプロシージャでは、指定した Access データベースを排他モードで開き、操作が成功したことを確認するためにエラー チェックを行います。エラーを表示する For Each…Next ループでは、ADO Error オブジェクトの SQLState プロパティを使用して Jet エラー番号を取得します。ADO を使用している場合、VBA Err オブジェクトの Number プロパティは Jet エラー番号を返しません。

  Sub OpenDBExclusive (strDBPath As String)
   Dim cnnDB As ADODB.Connection
   Dim errCurrent As ADODB.Error

   ' Connection オブジェクトを初期化します。
   Set cnnDB = New ADODB.Connection

   ' Microsoft Jet 4.0 プロバイダを指定し、
   ' strDBPath 変数で指定されたデータベースを
   ' 排他モードで開くことを試みます。
   On Error Resume Next
   With cnnDB
      .Provider = "Microsoft.Jet.OLEDB.4.0"
      .Mode = adModeShareExclusive
      .Open strDBPath
   End With

   If Err <> 0 Then
      ' エラーが発生した場合、エラーを表示します。
      For Each errCurrent In ADODB.Errors
         Debug.Print "エラー " & errCurrent.SQLState _
            & ": " & errCurrent.Description
      Next
   Else
      ' エラーが発生しない場合、排他的アクセスが許されます。
      Debug.Print "このデータベースは排他モードで開かれています。"
   End If

   ' Connection オブジェクトを閉じ、オブジェクト変数を破棄します。
   cnnDB.close
   Set cnnDB = Nothing
End Sub

OpenDBExclusive プロシージャは、Office 2000 Developer CD-ROM の ODETools\V9\Samples\OPG\Samples\CH16 サブフォルダに含まれる MultiuserDatabase.mdb サンプル ファイルの OpenDatabase モジュールにあります。

ADO を使用して Access データベースを排他モードで開いた場合も、[ファイル] メニューから [ファイルを開く] ダイアログ ボックスを開き [排他モードで開く] からデータベースを開いた場合と同様になります。書き込み権限を持つ 1 人のユーザーが既にデータベースを開き、別のユーザーが排他モードでそのデータベースを開こうとした場合、ロック エラーが発生します。そのため、最初のユーザーがデータベースを閉じない限り、排他モードで開くことはできません。共有データベースを開いているユーザーを特定する方法の詳細については、この章の「ユーザーの認識」を参照してください。

読み取り専用モードの使用方法

Connection オブジェクトの Mode プロパティを adModeRead に設定し、共有モードで読み取り専用としてデータベースを開く場合、ほかのユーザーもデータベースを開くことは可能ですが、書き込むことはできません。読み取り専用に設定することで、ユーザー レベル セキュリティが未確立のまま、現在のユーザーがデータやオブジェクトのデザインを変更できないようにします。ADO を使用し、読み取り専用モードで Access データベースを開いた場合も、[ファイル] メニューから [ファイルを開く] ダイアログ ボックスを開いての [読み取り専用として開く] からデータベースを開いた場合と同様になります。

メモ読み取り専用としてデータベースを開いても、ほかのユーザーは共有モード、読み取り/書き込みモードでデータベースを開くことができるため、ロックの競合は回避できません。

[ファイル] メニューから開く [ファイルを開く] ダイアログ ボックスには、[排他および読み取り専用として開く] もあり、これをクリックすると、読み取り専用と排他モードの両方でデータベースを開くことができます。ほかのユーザーはデータベースを開けなくなり、現在のユーザーも変更を加えることはできません。コードを使用して、排他、読み取り専用モードでデータベースを開く場合は、Mode プロパティを次に示すコードにあるように、+ 記号でつなぎ、adModeShareExclusive 定数および adModeRead 定数の両方を設定してください。

  cnnDB.Mode = adModeShareExclusive + adModeRead

共有モードでデータベースを開く

ほかのロック形式を実行する場合は、共有モードでデータベースを開いてください。共有モードでデータベースを開くと、複数ユーザーが同時にアクセスでき、Jet データベース エンジンによりユーザー間の競合が処理されます。

コードを使用して、共有モードでデータベースを開くことができます。Microsoft Jet 4.0 OLE DB Provider で ADO を使用すると、既定で、Connection オブジェクトの Open メソッドにより共有モードでデータベースが開きます。共有モードでデータベースを開くには、Mode プロパティを adModeShareDenyNone に設定してください。次のプロシージャでは、指定したデータベースを共有モードで開き、操作成功のエラー チェックを行います。

  Sub OpenDBShared (strDBPath As String)
   Dim cnnDB As ADODB.Connection
   Dim errCurrent As ADODB.Error

   ' Connection オブジェクトを初期化します。
   Set cnnDB = New ADODB.Connection

   ' Microsoft Jet 4.0 プロバイダを指定し、
   ' strDBPath  変数で指定されたデータベースを
   ' 排他モードで開くことを試みます。
   On Error Resume Next
   With cnnDB
      .Provider = "Microsoft.Jet.OLEDB.4.0"
      .Mode = adModeShareDenyNone
      .Open strDBPath
   End With

   If Err <> 0 Then
      ' エラーが発生した場合、エラーを表示します。
      For Each errCurrent In ADODB.Errors
         Debug.Print "Error " & errCurrent.SQLState _
            & ": " & errCurrent.Description
      Next
   Else
      ' エラーが発生しない場合、排他的アクセスが許されます。.
      Debug.Print "The database is open in shared mode."
   End If

   ' Connection オブジェクトを閉じ、オブジェクト変数を破棄します。
   cnnDB.close
   Set cnnDB = Nothing
End Sub

OpenDBShared プロシージャは、Office 2000 Developer CD-ROM の ODETools\V9\Samples\OPG\Samples\CH16 サブフォルダに含まれる MultiuserDatabase.mdb サンプル ファイルの OpenDatabase モジュールにあります。

ADO を使用して共有モードでデータベースを開いた場合も、[ファイル] メニューから [ファイルを開く] ダイアログ ボックスを開いて [開く] を選択した場合と同様になります。

エラーのチェック

コードを使用して任意のロック レベルでロックを設定する際、発生したエラーの処理が重要になります。Access では、設定前にロック設定可能を確認するのではなく、操作の実行後にロックの成功を確認します。

典型的なロック手順は、次の 4 つのプロセスからなります。

  1. エラー処理をオフにします。

  2. 操作を実行します。

  3. エラーが発生していないことを確認します。エラーが発生した場合は、エラー番号に基づいて処理してください。

  4. エラー処理をオンにします。

この方法は、ロックの設定前に 1 つ 1 つのエラーの可能性を気にすることなく、エラーが発生した時点で処理するため、非常に有効です。マルチユーザー コードを記述する場合は、メッセージを表示してユーザーが再度操作を実行できるようしてエラーを処理します。

排他モードの使用中に発生する最も一般的なエラーは、エラー番号 3006、"＜データベース名＞ は既に使用されているので、使用できませんでした。" です。このエラーは、ほかのユーザーが、現在、排他モードで開かれているデータベースを開こうとすると発生します。この場合は、現在使用しているユーザーの作業終了を待って操作を再実行してください。エラー処理の詳細については、第 8 章「エラー処理およびデバッグ」を参照してください。

レコードセット ロックの使用方法

データベース全体をロックするには排他モードを使用し、共有データベース内の 1 つのテーブル全体を指定してロックするにはレコードセット ロックを使用します。読み取りロックを指定すると、ほかのユーザーはそのテーブルのレコードを表示できなくなり、書き込みロックを指定した場合は編集ができなくなります。また、両方を指定することも可能ですが、ADO と OLE DB はレコードセット ロックに対応していないため、このロックが必要な場合は、DAO コードを使用してください。レコードセット ロックは、DAO テーブルおよびダイナセット タイプの Recordset オブジェクトにのみ適用されます。また、DAO スナップショット タイプまたは前方スクロール タイプである Recordset オブジェクトは基本的に読み取り専用となっているため、レコードセット ロックは使用できません。レコードセット ロックを適用する場合、Microsoft Jet では、共有テーブル読み取りロックおよび共有テーブル書き込みロックが使用されます。

共有モードでデータベースを開いた後、DAO OpenRecordset メソッドの Options 引数にある dbDenyRead 定数、dbDenyWrite 定数のどちらかを指定してレコードセット ロックを適用します。テーブルに読み取りロックと書き込みロックの両方を適用する場合、+ 記号で両方の定数を使用することも可能です。

レコードセット ロックで DAO Recordset オブジェクトを開くには

  1. Recordset オブジェクトのデータベースを共有モードで開きます。

  2. 使用するレコードセット ロックのタイプを指定します。

  3. OpenRecordset メソッドで Recordset オブジェクトを開き、Options 引数を設定して使用するロック タイプを指定します。

  4. データ操作の終了後、Recordset オブジェクトを閉じ、Recordset オブジェクトのロックを解除します。

たとえば、次のコードでは、OpenRecordset メソッドの Options 引数で指定された dbDenyWrite 定数および dbDenyRead 定数でテーブルを開き、ロックします。ほかのユーザーはこの処理中にこのテーブルへアクセスすることはできません。テーブルを開く際にエラーが発生した場合は、関数が Nothing を返します。この処理には、共有モードでデータベースを開き、開けないときにはエラーを処理する DAOOpenDBShared プロシージャが必要です。DAOOpenDBShared および DAOOpenTableExclusive プロシージャは、Office 2000 Developer CD-ROM の ODETools\V9\Samples\OPG\Samples\CH16 サブフォルダに含まれる MultiuserDatabase.mdb サンプル ファイルの RecordsetLocking モジュールにあります。

  Function DAOOpenTableExclusive(strDbPath As String, _
                               strRstSource As String) As DAO.Recordset
   Dim dbs As DAO.Database
   Dim rst As DAO.Recordset

   ' DAOOpenDBShared を呼び出して
   ' データベースを共有モードで開きます。
   Set dbs = DAOOpenDBShared(strDbPath)

   ' データベースが共有モードで開いたことを確認します。
   ' 開いた場合、指定したテーブルを排他的に開きます。
   If Not dbs Is Nothing Then
      Set rst = dbs.OpenRecordset(strRstSource, _
         dbOpenTable, dbDenyRead + dbDenyWrite)
      ' レコードセットが開いたことを確認します。開いた場合、
      ' Recordset オブジェクトを返します。開かなかった場合、Nothing を返します。
      If Not rst Is Nothing Then
         Set DAOOpenTableExclusive = rst
      Else
         Set DAOOpenTableExclusive = Nothing
      End If
   Else
      Set OpenTableExclusive = Nothing
   End If
End Function

重要   この処理により返された Recordset オブジェクトを操作するには、DAO コードを使用する必要があります。ADO コードを使用して DAO オブジェクトを操作することや、またその逆を行うことはできません。

メモ   Options 引数に値を指定せず Recordset オブジェクトを開くと、既定でレコード ロックとなり、共有モードで Recordset オブジェクトが開き、現在のレコードで編集中のデータのみがロックされます。

DAO で Recordset オブジェクトを開く方法の詳細については、DAO 3.6 ヘルプを参照してください。

レコードセット ロックでのエラーのチェック

排他モードでデータベースを開く際に Recordset オブジェクトのロックを設定すると、ロックできなかった場合にエラーが発生します。上の 4 つの手順どおり、エラー処理をオフにし、操作を実行、エラーをチェックして発生したエラーを処理した後にエラー処理をオンにします。

レコードセット ロックで最も一般的なエラーは、エラー番号 3262、":テーブルをロックできませんでした。" です。このエラーは、ロックできないオブジェクトに OpenRecordset メソッドを使用すると発生します。通常、ほかのユーザーが同じテーブルをロックしているため、そのユーザー以外による操作が不可能になっています。このエラーを処理するには、しばらく待ってから再度操作を行ってください。

ページ レベル ロックとレコード レベル ロックの使用方法

排他モードで開いたデータベースではデータベース全体がロックされ、レコードセット ロックを使用した場合はテーブルがロックされますが、ページ レベル ロックあるいはレコードセット ロックを使用した場合は、現在編集中のレコードが含まれるページおよびレコードのみがロックされ、制限レベルとしては最も低いものとなります。この場合、ほかのユーザーはページまたはレコードからデータを取得できますが、変更はできません。レコード レベル ロックは ADO および DAO Recordset オブジェクトの既定値です。また、ページ レベル ロックは ADO Command オブジェクトまたは DAO QueryDef オブジェクトを使用する SQL DML ステートメント (UPDATE、DELETE、および INSERT INTO ステートメントなどの大規模な操作) の既定値となっています。

ページ レベルまたはレコード レベルでデータをロックする Recordset オブジェクトを操作する場合は、ペシミスティック ロックまたはオプティミスティック ロックのどちらかを選択し、使用するロック タイプを指定してください。

ADO Recordset オブジェクトのロック タイプを設定するには、Recordset オブジェクトに用意されている Open メソッドの LockType 引数にある adLockPessimistic 定数または adLockOptimistic 定数を指定します。DAO Recordset オブジェクトの場合は、LockEdits プロパティを設定してロック タイプを変更できますが、ADO Recordset オブジェクトを開いた後にロック タイプを変更することはできません。

ペシミスティック ロック

ペシミスティック ロックでは、レコードの編集を開始するとそのレコードまたはレコードがあるページがロックされます。ADO の場合は、編集作業の開始にあたって、DAO のように Edit メソッドを使用しません。ADO 内のフィールド値を編集するには、単に Field オブジェクトの Value プロパティを変更してください。新規レコードへ移動、あるいは Update メソッドを使用してレコードへの変更を保存しない限り、レコードまたはページはロックされたままになります。バッチ更新を使用していない場合は、新規レコードへの移動前に CancelUpdate メソッドを使用して編集をキャンセルしてください。

ペシミスティック ロックの主な利点は、レコードがロックされている限り競合が発生しないところです。さらに、ペシミスティック ロックでは、ユーザーがレコードの編集を開始するとそのほかのユーザーは変更を加えることができなくなるため、ソリューションが常に最新データを取得する保証になります。

逆にペシミスティック ロックの不便な点は、ページ レベル ロックを使用すると、処理中はページ全体がロックされるため、ロックが解除されるまで他のユーザーがそのページのレコードを変更できないところです。ADO および DAO Recordset オブジェクトでは既定でレコード レベル ロックが使用されるため、既定設定に上書きした場合にのみこの点が問題となります。

コードでペシミスティック ロックを使用するには

  1. Recordset オブジェクトを開く際、そのオブジェクトに用意されている Open メソッドの LockType 引数を adLockPessimistic に設定してペシミスティック ロックを適用します。

  2. 目的のレコードへ移動します。

  3. Field オブジェクトへの変更を指定してレコードを編集します。ペシミスティック ロックを使用すると、ADO により、最初の Field オブジェクトの編集を開始した直後にそのレコードがロックされます。

  4. レコードがロックされた後、変更を加えます。

  5. 新規レコードへ移動、または Update メソッドを使用してレコードへの変更を保存します。変更の保存後、ロックが解除されます。

オプティミスティック ロック

オプティミスティック ロックでは、新規レコードへ移動、または Update メソッドを使用してレコードへの変更を保存する際に、レコードまたはページがロックされます。オプティミスティック ロックの主な利点は、ソリューションでレコードを更新する場合のみロックされるため、ロック時間が短くなることです。

オプティミスティック ロックの不便な点は、レコードの編集中に正しい更新を確認できないことです。ほかのユーザーが最初にレコードを更新した場合、レコード編集の更新は行われません。

コードでオプティミスティック ロックを使用するには

  1. Recordset オブジェクトを開く際、そのオブジェクトに用意されている Open メソッドの LockType 引数を adLockOptimistic に設定してオプティミスティック ロックを適用します。

  2. 目的のレコードへ移動します。

  3. Field オブジェクトへの変更を指定してレコードを編集します。オプティミスティック ロックを使用すると、レコードはロックされません。

  4. 新規レコードへ移動、または Update メソッドを使用してレコードへの変更を保存します。この時点でレコードがロックされます。

  5. Update メソッドが成功したことを確認します。失敗した場合は再度保存してください。

オプティミスティック ロックでは、Update メソッドが失敗する可能性もあります。たとえば、1 人のユーザーがオプティミスティック ロックで Recordset オブジェクトを開いている際、ほかのユーザーがオプティミスティック ロックで同じページのデータを更新しようとしても失敗します。

メモ トランザクションを使用している場合、オプティミスティック ロックはペシミスティック ロックに変更されます。トランザクションによりデータがロックされ、トランザクションが完了するまで変更できなくなるため、LockType 引数が adLockOptimistic に設定されていてもペシミスティック ロックが使用されます。トランザクションの詳細については、この章の「トランザクションの使用方法」を参照してください。

レコード レベル ロックとページ レベル ロックでのエラーのチェック

レコード レベル ロックまたはページ レベル ロックを使用する場合は、作業を進める前に、ロックが成功したことをコードで確認してください。排他モードやレコードセット ロックの場合と同様に、エラー処理をオフにし、操作を実行、エラーをチェックして発生したエラーを処理した後にエラー処理をオンにします。

次の表は、レコード レベル ロックまたはページ レベル ロックを使用する際に発生する最も一般的な 3 つのエラーについて説明したものです。これらは、Jet データベース エンジンにより返されます。

エラー番号とテキスト 原因と対処方法
3218 "現在ロックされているので、更新できませんでした。" 別のユーザーがロックしているレコードを保存しようとすると発生します。

しばらくの間待ってから再度レコードを保存するようにソリューションをプログラミングするか、問題を説明するメッセージを表示してユーザーがその操作を再度実行できるようにします。
3197 "ほかのユーザーが同じデータに対して同時に変更を試みているので、プロセスが停止しました。" 現在のユーザーによるレコード更新の試行開始後に別のユーザーがデータを更新すると発生します。このエラーがいつ発生するかは、使用しているロックによって異なります。
  • ペシミスティック ロックを使用している場合、ほかのユーザーがレコードへの変更を保存し、その後現在のユーザーが編集を始めると発生します。

  • オプティミスティック ロックを使用している場合、ほかのユーザーがレコードへの変更を既に保存した後、Update  メソッドで変更を保存すると発生します。

どちらの場合も、メッセージを表示して別のユーザーがデータを変更したことを通知するようにソリューションをプログラミングしてください。現在のデータを表示して、ほかのユーザーが加えた変更への上書き、または編集のキャンセルを選択できるようにすることも可能です。
3260 "マシン <マシン名> のユーザー <ユーザー名> によってロックされているので、更新できませんでした。" ユーザーがロックされているレコード、またはページ レベル ロックを使用している場合はそのページを編集しようとすると発生します。

ページ レベル ロックを使用している場合は、AddNew メソッドまたは Update メソッドを使用してロックされたページのレコードを保存する際にも発生します。新規レコードを保存する場合、またはオプティミスティック ロックが使用されている場合に別のユーザーがそのページをロックすると、このような状況が発生します。

しばらくの間待ってから再度レコードを保存するようにソリューションをプログラミングするか、問題を説明するメッセージを表示してユーザーがその操作を再度実行できるようにします。

レコード レベル ロックまたはページ レベル ロックのコード例

レコードをロックし、エラーをチェックしてエラー タイプに関係なく応答するようプロシージャを記述することが可能です。また、発生したエラーを識別し、応答するプロシージャを記述することもできます。次のプロシージャでは、レコードを編集し、ロック エラーが発生すると、プロシージャにより、エラーを識別し、適切に応答します。不明なエラーが発生した場合にはメッセージが表示され、その機能が終了します。

  Function UpdateUnitsInStock(strProduct As String, _
                            intUnitsInStock As Integer,_
                            intMaxTries As Integer) As Boolean
   Dim strConnect      As String
   Dim cnn             As ADODB.Connection
   Dim rstProducts     As ADODB.Recordset
   Dim blnError        As Boolean
   Dim intCount        As Integer
   Dim intLockCount    As Integer
   Dim intChoice       As Integer
   Dim intRndCount     As Integer
   Dim intI            As Integer
   Dim strMsg          As String

   Const MULTIUSER_EDIT As Integer = 3197
   Const RECORD_LOCKED As Integer = 3218
   Const NWIND_PATH As String = "C:\OPG\Samples" _
      & "\CH05\Nwind.mdb"

   On Error GoTo UpdateUnitsInStockError

   ' 接続文字列をフォーマットしてデータベースを開きます。
   strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & NWIND_PATH

   ' データベースを開きます。
   Set cnn = New ADODB.Connection
   cnn.Open strConnect

   ' ペシミスティック ロックを使って Products テーブルを開いて編集します。
   Set rstProducts = New ADODB.Recordset
   rstProducts.Open "Products", cnn, adOpenKeyset, _
      adLockOptimistic, adCmdTableDirect

   With rstProducts
      .Find Criteria:="ProductName = " & "'" & strProduct & "'", _
          SkipRecords:=0, _
          SearchDirection:=adSearchForward

      If .EOF Then
         MsgBox "レコードが見つかりません。"
         UpdateUnitsInStock = False
         GoTo UpdateUnitsInStockExit
      End If

      ' レコードの編集を試みます。ロック エラーが発生した場合、
      ' エラー ハンドラが処理しようとします。このプロシージャはペシミスティック
      ' ロックを使用するため、レコードを編集しようとしたときに
      ' エラーが発生します。オプティミスティック ロックを
      ' 使用している場合、レコードが更新されたときにエラーが発生します。

      ![UnitsInStock] = intUnitsInStock
      .Update
      UpdateUnitsInStock = True
   End With
   
UpdateUnitsInStockExit:
   On Error Resume Next
   rstProducts.Close
   Set rstProducts = Nothing
   Exit Function

UpdateUnitsInStockError:
   ' Jet エラー番号を抽出するために Errors コレクション内の
   ' 最初の Error オブジェクトの SQLState プロパティをチェックします。
   Select Case cnn.Errors(0).SQLState
      
      Case MULTIUSER_EDIT
         ' レコードセットが開かれてから、そのデータは変更されています。
         ' 現在の値を表示し、上書きのオプションを提示します。
                        
         strMsg = "レコードを開いた後にほかのユーザーがレコードに変更を加えました。" _
            & vbCr & "現在の UnitsInStock の値: " _
            & rstProducts.Fields("UnitsInStock").OriginalValue & vbCr _
            & "保存しますか ?"
         intChoice = MsgBox(strMsg, vbYesNo + vbQuestion)
         If intChoice = vbYes Then
            Resume
         Else
            UpdateUnitsInStock = False
            Resume UpdateUnitsInStockExit
         End If

      Case RECORD_LOCKED
         ' レコードがロックされます。
         intLockCount = intLockCount + 1
         ' ロックの取得 2 回試みられた場合、キャンセルまたは再試行を促します。
         If intLockCount > 2 Then
            intChoice = MsgBox(Err.Description & " Retry?", _
               vbYesNo + vbQuestion)
            If intChoice = vbYes Then
               intLockCount = 1
            Else
               UpdateUnitsInStock = False
               Resume UpdateUnitsInStockExit
            End If
         End If

         ' Windows に戻ります。
         DoEvents
         ' ロックが失敗する度に
         ' ロックが失敗する度にランダム間隔を長くします。
         intRndCount = intLockCount ^ 2 * Int(Rnd * 3000 + 1000)
         For intI = 1 To intRndCount
         Next intI
         Resume             ' 再度、編集を試みます。
      Case Else             ' 予期しないエラー。
         MsgBox "エラー " & cnn.Errors(0).SQLState & ": " _
               & Err.Description, vbOKOnly, "ERROR"
         UpdateUnitsInStock = False
         Resume UpdateUnitsInStockExit

   End Select
End Function

UpdateUnitsInStock プロシージャは、Office 2000 Developer CD-ROM の ODETools\V9\Samples\OPG\Samples\CH16 サブフォルダに含まれる MultiuserDatabase.mdb サンプル ファイルの RecordLocking モジュールにあります。

コードでランダム間隔を指定し、操作を再実行します。この設定は、2 人のユーザーが同じレコードを更新しようとした際、コードにより同時にレコードをロックするデッドロック状態に陥らないためにも重要です。タイミング ループにランダム要素を含め、デッドロックの発生を最小限にとどめることができます。

レコードのロック状況をテストする

ページを実際にロックすることなく、そのレコードのロック状況を確認します。次のプロシージャでは、現在のレコードを編集し、そのロック状況を判断します。

  Function IsRecordLocked(strProduct) As Boolean
   Dim rst             As ADODB.Recordset
   Dim strConnect      As String
   Dim cnn             As ADODB.Connection
   Dim strSQL          As String
   On Error GoTo RecordLockedError

   Const NWIND_PATH As String = "C:\OPG\Samples" _
      & "\CH05\Nwind.mdb"
   ' 接続文字列をフォーマットしてデータベースを開きます。
   strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & NWIND_PATH
   
   ' データベースを開きます。
   Set cnn = New ADODB.Connection
   cnn.Open strConnect
   
   ' SQL ステートメントをフォーマットして、指定したレコードの Recordset オブジェクトを開きます。
   strSQL = "SELECT Products.ProductName,Products.UnitsInStock FROM " _
      & "Products WHERE Products.ProductName ='" & strProduct & "';"
   
   ' ペシミスティック ロックを使用して Products テーブルを開いて編集します。
   Set rst = New ADODB.Recordset
   With rst
      .Open strSQL, cnn, adOpenKeyset, _
         adLockPessimistic, adCmdText
      
      ' レコードが見つからない場合、メッセージを表示し、False を戻して終了します。
      If .EOF Then
         MsgBox "レコードが見つかりません。"
         IsRecordLocked = False
         GoTo IsRecordLockedExit
      End If
      
      ' レコード内の値を編集することを試みます。成功した場合、
      ' False を返します。失敗した場合、エラーがトリガされます。
      ![UnitsInStock] = 999
      IsRecordLocked = False
   End With
   
IsRecordLockedExit:
   rst.CancelUpdate
   rst.Close
   Set rst = Nothing
   cnn.Close
   Set cnn = Nothing
   Exit Function

RecordLockedError:
   Select Case cnn.Errors(0).SQLState
      ' レコードがロックされます。
      Case 3260
         IsRecordLocked = True
         GoTo IsRecordLockedExit
      Case Else
         Resume Next
   End Select
End Function

IsRecordLocked プロシージャは、Office 2000 Developer CD-ROM の ODETools\V9\Samples\OPG\Samples\CH16 サブフォルダに含まれる MultiuserDatabase.mdb サンプル ファイルの RecordLocking モジュールにあります。