競合の検出および解決

適用先: Access 2013、Office 2013

競合を検出し、解決する

Recordset を即時モードで処理する場合は、コンカレンシーの問題が発生する可能性がはるかに低くなります。 一方、アプリケーションでバッチ モードの更新を使用している場合、同じレコードを編集している別のユーザーによる変更が保存される前に、あるユーザーがレコードを変更する可能性が高くなります。 このような場合は、アプリケーションで競合を適切に処理する必要があります。 最後のユーザーがサーバーに更新プログラムを送信して "優先" することを望む場合があります。または、最新のユーザーに、競合する 2 つの値のどちらかを選択して、どの更新プログラムを優先するかを決定することもできます。

いずれにしても、ADO では、この種類の競合を処理するために、 Field オブジェクトの UnderlyingValue プロパティと OriginalValue プロパティを使用します。 これらのプロパティを Recordset の Resync メソッドおよび Filter プロパティと組み合わせて使用します。

エラーを検出する

バッチ更新中に ADO で競合が発生すると、 Errors コレクションに警告が表示されます。 そのため、BatchUpdate を呼び出した直後に常にエラーをチェックし、見つかった場合は、競合が発生したという前提のテストを開始する必要があります。 最初の手順では、Recordset の Filter プロパティを adFilterConflictingRecords に設定します (Filter プロパティについては、前の章で説明します)。 これにより、 Recordset のビューが競合しているレコードのみに制限されます。 この手順の後に RecordCount プロパティが 0 に等しい場合は、競合以外のによってエラーが発生したことがわかります。

BatchUpdate を呼び出すと、ADO およびプロバイダーは、データ ソースに対して更新を実行するための SQL ステートメントを生成します。 一部のデータ ソースでは、WHERE 句で使用できる列の種類が限定されているため、注意が必要です。

次に、AffectRecords 引数が adAffectGroup と等しく設定され、ResyncValues 引数セットが adResyncUnderlyingValues と等しい Recordset で Resync メソッドを呼び出します。 Resync メソッドは、基になるデータベースから現在の Recordset オブジェクト内のデータを更新します。 adAffectGroup を使用すると、現在のフィルター設定で表示されるレコード (競合するレコードのみ) のみがデータベースと再同期されるようにします。 これにより、大規模な Recordset を処理する場合、パフォーマンスに大きな違いが生じます。 Resync を呼び出すときに ResyncValues 引数を adResyncUnderlyingValues に設定することで、データベースの (競合している) 値が UnderlyingValue プロパティに含まれ、Value プロパティがユーザーによって入力された値を保持し、OriginalValue プロパティがフィールドの元の値 (最後に成功した UpdateBatch 呼び出しが行われる前の値) を保持するようにします。 その後、これらの値を使用して、プログラムによって競合を解決したり、使用する値をユーザーに選択させる必要があります。

この手法を次のコード例に示します。 この例では、別の Recordset を使用して、 UpdateBatch が呼び出される前に基になるテーブルの値を変更することにより、意図的に競合を発生させます。

 
'BeginConflicts 
    On Error GoTo ErrHandler: 
     
    Dim objRs1 As New ADODB.Recordset 
    Dim objRs2 As New ADODB.Recordset 
    Dim strSQL As String 
    Dim strMsg As String 
     
    strSQL = "SELECT * FROM Shippers WHERE ShipperID = 2" 
                  
    'Open Rs and change a value 
    objRs1.CursorLocation = adUseClient 
    objRs1.Open strSQL, strConn, adOpenStatic, adLockBatchOptimistic, adCmdText 
    objRs1("Phone") = "(111) 555-1111" 
     
    'Introduce a conflict at the db... 
    objRs2.Open strSQL, strConn, adOpenKeyset, adLockOptimistic, adCmdText 
    objRs2("Phone") = "(999) 555-9999" 
    objRs2.Update 
    objRs2.Close 
    Set objRs2 = Nothing 
     
    On Error Resume Next 
    objRs1.UpdateBatch 
     
    If objRs1.ActiveConnection.Errors.Count <> 0 Then 
        Dim intConflicts As Integer 
         
        intConflicts = 0 
         
        objRs1.Filter = adFilterConflictingRecords 
         
        intConflicts = objRs1.RecordCount 
         
        'Resync so we can see the UnderlyingValue and offer user a choice. 
        'This sample only displays all three values and resets to original. 
        objRs1.Resync adAffectGroup, adResyncUnderlyingValues 
         
        If intConflicts > 0 Then 
            strMsg = "A conflict occurred with updates for " & intConflicts & _ 
                     " record(s)." & vbCrLf & "The values will be restored" & _ 
                     " to their original values." & vbCrLf & vbCrLf 
                      
            objRs1.MoveFirst 
            While Not objRs1.EOF 
                strMsg = strMsg & "SHIPPER = " & objRs1("CompanyName") & vbCrLf 
                strMsg = strMsg & "Value = " & objRs1("Phone").Value & vbCrLf 
                strMsg = strMsg & "UnderlyingValue = " & _ 
                                   objRs1("Phone").UnderlyingValue & vbCrLf 
                strMsg = strMsg & "OriginalValue = " & _ 
                                   objRs1("Phone").OriginalValue & vbCrLf 
                strMsg = strMsg & vbCrLf & "Original value has been restored." 
                   
                MsgBox strMsg, vbOKOnly, _ 
                      "Conflict " & objRs1.AbsolutePosition & _ 
                      " of " & intConflicts 
                   
                objRs1("Phone").Value = objRs1("Phone").OriginalValue 
                objRs1.MoveNext 
            Wend 
             
            objRs1.UpdateBatch adAffectGroup 
        Else 
            'Other error occurred. Minimal handling in this example. 
             strMsg = "Errors occurred during the update. " & _ 
                        objRs1.ActiveConnection.Errors(0).Number & " " & _ 
                        objRs1.ActiveConnection.Errors(0).Description 
        End If 
         
        On Error GoTo 0 
    End If 
     
    objRs1.MoveFirst 
     
    'Clean up 
    objRs1.Close 
    Set objRs1 = Nothing 
    Exit Sub 
     
ErrHandler: 
    
    If Not objRs1 Is Nothing Then 
        If objRs1.State = adStateOpen Then objRs1.Close 
        Set objRs1 = Nothing 
    End If 
     
    If Not objRs2 Is Nothing Then 
        If objRs2.State = adStateOpen Then objRs2.Close 
        Set objRs2 = Nothing 
    End If 
     
    If Err <> 0 Then 
        MsgBox Err.Source & "-->" & Err.Description, , "Error" 
    End If 
     
'EndConflicts 

現在の Record または特定の Field の Status プロパティを使用すると、どのような競合が発生したのかを判断できます。

エラー処理の詳細については、「6 章: エラー処理」を参照してください。