Microsoft Access2003

Page 15(2005/03)

マルチユーザー
私の場合はマルチユーザーの必要はないのですけど、どのようなものなのか試してみました。基本的には、同じレコードを複数のユーザーが同時に変更した場合の競合の問題だけだろうと思いますけど、これがややこしい。
「ツール」メニューのなかの「オプション」の「詳細」タブが左の図です。
mdb全体のデフォルトの設定です。
共有モードと排他モードがありますが、デフォルトでは共有モードです。排他モードだと、誰かがmdbを開いていると、他の人はそれをオープンできません。
レコードのロックですが、設定が3種類あり、デフォルトでは「ロックしない」となっています。

データベース、mdbを排他モードに設定した場合、他のユーザーがそれを開こうとすると次のようなメッセージが出ます。
不思議なことに、共有モードでなら開けてしまうのですね。これは意味がよく分からない・・・。排他モードで開いたデータベースが他のPCから共有モードでオープンできて、データの変更もできてしまう。ナゾです(^^ゞ
よく分からないユーザーインターフェースレベルでの排他共有はひとまずおいといて(^^ゞ、コードレベルでデータベースを排他オープンする方法のサンプルです。OpenDatabase("データベース名",true)とするわけですが、mdbはフルパスで指定しないとまずいようです。
オプションのTrueで排他オープン、 Falseで共有。さらにもうひとつオプションでTrueを付けると、排他+ReadOnlyということになります。
目的のmdbを他のユーザーがオープンしていると、下の図のようなエラーメッセージが出ます。
エラーメッセージの内容ですが、VBA.mdbを共有モードで開いていても、下のようなメッセージになるようです。
もっとも、すでにオープンしているmdbを排他オープンしようとするわけですから、無理な話です。
Sub OpenDatabaseExclusive()
  Dim dbs As Database
  Dim errCurrent As Error
  On Error Resume Next   'これを入れないと次の行でエラーになったときに中断してしまう
  Set dbs = OpenDatabase("C:\Documents and Settings\shimane hiroshi\My Documents\Access_Data\VBA.mdb", True)
  If Err <> 0 Then
    For Each errCurrent In DBEngine.Errors
      MsgBox Err.Number & Space(2) & Err.Description
    Next
  Else
    MsgBox "データベースを排他モードで開きました"
  End If
  dbs.Close
End Sub
上の例はデータベース全体の排他/共有の話ですが、レコードセットのレベルでも設定ができるわけで、上のコードをアレンジしてみました。
OpenRecordsetの3番目の引数はoptions、4番目の引数はlockeditsです。
オプションでは、dbDenyWriteで書き込み禁止、dbDenyReadで読取りまで禁止できます。
lockeditsではdbReadOnlyで書き込み禁止。
dbPessimisticでは Editメソッドの発行と同時にページがロックされます。排他的ロック。
dbOptimisticでは Updateメソッドが実行されるまではロックされません。共有的ロック。
下の例では、テーブル「社員」をオープンした状態で実行すると下のようなメッセージが出ます。
Sub OpenRecordsetExclusive() 'レコードセットを排他で開く
  Dim dbs As Database
  Dim rs As Recordset, rs2 As Recordset
  Dim errCurrent As Error
  On Error Resume Next 'これを入れないと次の行でエラーになったときに中断してしまう
  Set dbs = CurrentDb
  Set rs = dbs.OpenRecordset("社員", dbOpenDynaset, dbDenyWrite, dbPessimistic)
  If Err <> 0 Then
    MsgBox Err.Number & Space(2) & Err.Description
  Else
    MsgBox "テーブル社員をdbDenyWrite & dbPessimisticで開きました"
  End If
  rs.Close
  dbs.Close
End Sub
Recordsetの場合はデフォルトではページロックの排的ロックということらしいです。つまり、データに変更を加えている間は、メモリーに読み込まれているデータはロックされるということですね。レコードセットのLockEditsプロパティをFalseにすると共的ロックになり、そのレコードが同時に変更された場合に左図のような警告のメッセージが出ます。
フォーム・レベルでのロック
連結フォームは「RecordLocks/レコードロック」プロパティで3種類の設定ができます。下の三つのフォームはまったく同じ内容ですが、それぞれレコードロックの方法を変えています。
規定値は「しない」です。これは共有的ロック状態で、同じレコードを2人のユーザーが同時に変更できますが、レコードを保存するときに競合が起こるので、後から保存したユーザーには警告メッセージが出ます。どちらの変更を優先するか・・ですね。
「すべてのレコード」に設定すると、文字通りフォームの基になるテーブル/クエリはすべてロックされます。この場合、基になっているテーブル「社員」が開かれているロックできないため、フォーム自体が開けずエラーになります。
「編集済みレコード」は排他的ロックといわれるもので、フォームのレコードの編集を始めると、メモリに読み込まれているページがロックされて、編集が終わるまでロックされます。そんなわけで、この三つのフォームは、「frm社員_すべて」を最初にオープンしないとダメです。
(ここで使っているテーブル「社員」はAccessのサンプル・データベース Northwind.mdb に含まれているものです)
この3個のフォームを平行して使ってみると面白いです。
「frm社員_すべて」フォームを開くと、後から開いた他のフォームは編集不可になります。「すべて」フォームを閉じてもロック状態は解除されません。クローズしてサイドオープンするとロックは解除されます。
「すべて」フォームでレコードの修正をして保存すると、他のフォームも変更が反映されます。

「frm社員_編集済み」と「frm社員_しない」との組合せでは、どちらを変更保存しても即座に他のフォームに変更が反映されます。
ただ、「編集済み」でレコードを編集すると、レコードを保存するまでは「しない」フォームではレコードの修正は受け付けなくなるのがわかります。
逆に、「しない」フォームで修正した後、「編集済み」フォームでもレコードを変更した場合は、どちらのフォームのレコードを先に保存するかで動作が少し変わるようです。
共有的ロックの状態で同時にひとつのレコードが変更された場合、後からレコードを保存したフォームではこの図のようなメッセージが出ます。
これはエラーメッセージではないようです。
もうひとつ、別のサンプルから
データ変更の競合を防ぐためには、データを編集するときレコードをロックしてしまえばいい訳ですが、他のユーザーを排除してしまうマイナス面もあるということで、一定時間経過すると自動的に変更を保存するというフォームのサンプルです。

フォームの「レコードロック」プロパティは「編集済みレコード」に設定します。
あとは「タイマー間隔」を例えば10000ミリ秒など、適当な間隔を指定して、下のようなタイマーイベントでレコードを保存します。
レコードを変更するとDirtyプロパティがTrueになりますが、これをFalseに設定するとデータを書き込むらしいです。
Option Compare Database
Option Explicit

Dim blnFlag As Boolean
Private Sub cmdSave_Click()
  On Error GoTo Err_cmdSave_Click
  DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
  Exit Sub
Err_cmdSave_Click:
  MsgBox Err.Number & Space(2) & Err.Description
  Exit Sub
End Sub

Private Sub Form_Load()
  blnFlag = False 'フォームをオープンしたときは編集フラグはFalseにしておく
End Sub

Private Sub Form_Timer()
  If Me.Dirty = True Then 'レコードを変更した場合
    If blnFlag = False Then
      blnFlag = True
    Else
      blnFlag = False
      Me.Dirty = False
      MsgBox "強制保存しました"
    End If
  End If
End Sub
こちらは上のフォームとほとんど同じですが、レコードロック・プロパティはデフォルトの「しない」のままです。共有的ロックのため、データの競合が起こりますが、上に載せた標準のデータ競合のプロンプトメッセージのかわりにユーザーのメッセージで処理を分岐させるものです。
変更のあったコントロールごとに修正するか変更を放棄するかを選択できるところが特徴ですが、手の込んだプログラムで、理解するのに時間がかかります。

フォームに連結するテープルは何でも良いのですが、Northwind.mdbの「商品」テーブルを使いました。このフォームと、商品テーブルの一覧リストを開き、同じレコードをどちらも修正してから、一覧リストのレコードの保存をした後、フォームのSaveRecordボタンをクリックして保存すると、HandleLocksプロシージャが動きます。
Option Compare Database
Option Explicit

Private Sub cmdSave_Click()
  On Error GoTo Err_cmdSave_Click
  DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
  Exit Sub
Err_cmdSave_Click:
  MsgBox Err.Number & " : " & Err.Description
  Exit Sub
End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
  Dim MsgResponse As Integer
  If (DataErr >= 3187 And DataErr <= 3262) Or DataErr = 7787 Or DataErr = 3167 Then
    Response = 0
    If DataErr = 3167 Then 'レコードが削除されているときの処理
      DoCmd.DoMenuItem 0, 1, 0, 0, acMenuVer70
      MsgResponse = MsgBox("レコードは他のユーザーによって削除されています。リフレッシュしますか?", vbYesNo)
      If MsgResponse = vbYes Then
        Me.Requery
      End If
      Exit Sub
    End If
  End If
  MsgBox DataErr & Err.Description
  Call HandleLocks(255, 0)
End Sub

Sub HandleLocks(ChangeColor As Long, OriginalColor As Long)
  Dim ctl As Control
  Dim MsgResponse As Integer, Msg As String
  Dim ChangeFields As New Collection, CF As Control, CollectCount As Integer
  Dim rs As Recordset
  Dim RSC As Recordset
  
  Set RSC = Me.RecordsetClone
  RSC.Bookmark = Me.Bookmark 'Recordsetのポインタをフォームのレコードに同期させる
  
  For Each ctl In Me.Controls 'フォーム上のテキストボックス・コントロールの値とレコードセットの値を比較する
    If ctl.ControlType = acTextBox Then
      If ctl <> RSC(ctl.ControlSource) Then '変更があった場合は文字を赤にする
        ctl.ForeColor = ChangeColor
        ctl.Tag = RSC(ctl.ControlSource) '変更前の値を各コントロールのTagに保存する
        ChangeFields.Add ctl '変更されたコントロールをコレクションに追加する
      End If
    End If
  Next
  MsgResponse = MsgBox("他の人がレコードを修正しました." & _
    "この変更を破棄するのなら はい(Yes)" & vbCrLf & "いいえ(No)で相手の変更した値を比較できます。" & _
    Chr(13) & Chr(13) & "あなたの変更を破棄しますか?", vbYesNo)
  If MsgResponse = vbYes Then
    For Each CF In ChangeFields '自分の変更を破棄する場合は
      CF = CF.Tag       'コレクションのコントロールのTagに保持していた前値を戻す
      CF.ForeColor = OriginalColor
      CF.Tag = ""
    Next
    For CollectCount = ChangeFields.Count To 1 Step -1
      ChangeFields.Remove CollectCount 'コレクションの中身を削除する
    Next CollectCount
    Exit Sub
  End If
  For Each CF In ChangeFields
    Msg = "フィールド " & CF.Name & " の、先方がが変更した値は " & Chr(13) & CF.Tag & " です。自分の変更を破棄しますか?"
    MsgResponse = MsgBox(Msg, vbYesNo)
    If MsgResponse = vbYes Then 'ここでもう一度変更を破棄できるようにする
      CF = CF.Tag
      CF.ForeColor = OriginalColor
      CF.Tag = ""
    Else
      'ここでは変更を破棄せずに修正を登録する
      Set rs = CurrentDb.OpenRecordset((Me.RecordSource), dbOpenDynaset)
      rs.MoveLast
      rs.MoveFirst
      rs.AbsolutePosition = Me.CurrentRecord - 1
      'rs.Bookmark = Me.Bookmark 'こちらでも問題ない
      rs.Edit
      rs((CF.ControlSource)) = CF.Value 'コレクションに保存した変更値でレコードセットの値を書き換える
      rs.Update
      CF.ForeColor = OriginalColor
      CF.Tag = ""
    End If
  Next
  For CollectCount = ChangeFields.Count To 1 Step -1
    ChangeFields.Remove CollectCount
  Next CollectCount
End Sub
マルチユーザーで使用する場合、データの競合をどのようにするか?が問題ですけど、やってみるとやはり難しいものがあります。
基本的には排他を使用せず、共有状態でできるだけ複数のユーザーが同時に作業できるように、緩やかなロックを使うほうがいいみたいです。
もちろん、大量のデータを一気に処理する場合などには、他のユーザーを閉め出す排他状態で作業するのが原則なのでしょう。
それにしても、Access97時代のオフィシャルなガイドブックを2冊ほど使って勉強してみたのですが、かなり情報不足の感じがします。
もっともマルチユーザーのアプリを開発するくらいのひとは、すでにそれなりの知識を持っているということなのかもしれないのですけど。

データの競合では何種類ものエラーメッセージが出るのですが、エラーメッセージに関するヘルプがあまりないのにも困りました。
このマルチユーザーの場合、エラーをどの様に処理するか?が大きなポイントになるようです。


Page Topへ戻る