エクセルＶＢＡで共有ファイル読込時の競合を感知できますか？

質問

職場ネットワークで、エクセルのファイルの共有を
しています。
誤ったファイル名を指定した場合は、次のＶＢＡで
メッセージを出せますが、他の人が同一ファイルを
既に開いていることを、ＶＢＡでどのように検出
すればよいのでしょうか。（当方ＶＢＡ素人です）
On Error Resume Next
Workbooks.Open Filename:=PathName & "\" &
FileName
If Err.Number <> 0 Then
x = MsgBox("ファイルが見つかりません",
vbOKOnly)
End If

回答No.4

Wendy02 · ベストアンサー

こんにちは。
＞（文中の16は意味が分からなかったので記入しませんでした）

Msgbox "ファイルが存在しません",16
16の意味は、赤いバッテンの「vbCritical」のことです。

＞存在しないファイルが生成されてしまい、Workbooks.Open FNameで、そのファイルを開いています。

よく分かっていませんが、Excelのブックのオブジェクトが生成されている、ということでしょうけれども、Close したはずでも、サーバーという環境では、一過性で生成されたオブジェクトが、プロシージャ実行中では残っている可能性がありますね。

以下でダメなら、「編集可能状態のチェック」は一旦終えて、再び別のプロシージャで「ブックを開ける」ようにしたほうが良いかもしれません。タイムラグはしょうがないと思います。

Sub KUTest3()
　Dim Fno As Integer
　Dim BookName As String
　Dim Fname As String
　'パスは、必ず「\」最後につけてください。
　Const myPath As String = "ドライブ\\パス\"
　BookName = "ブック名"
　Fname = myPath & BookName
　If Dir(Fname) = "" Then
　　MsgBox "ファイルが存在しません", vbCritical
　End If
　Fno = FreeFile
　On Error GoTo ErrHandler
　Open Fname For Binary Lock Read Write As #Fno
　Close #Fno
　Workbooks.Open Fname
　Exit Sub
ErrHandler:
　If Err.Number <> 0 Then
　MsgBox "現在、そのブックは編集可能ではありません。", vbCriticalEnd
　If
End Sub

お礼

ありがとうございました。
ＯＳが表示する「読み取り専用」は抑止できませんでしたが、Wendy02さんのアドバイスにより、
デバックモードでＶＢ命令の意味を確認しながら、より完成度の高いエクセルマクロを完成させることができました。

回答No.3

Wendy02

すみませんが、もう一度試していただけませんか？
単に、バイナリ・オープンでロックして書き込めるかどうかをチェックするだけですが。

Sub KUTest2()
Dim Fno As Integer
Const FName As String = "ドライブ\ファイル名"
If Dir(FName) ="" Then
Msgbox "ファイルが存在しません",16
End if
Fno = FreeFile
On Error Resume Next
　Open FName For Binary Lock Write As #Fno
Close #Fno
If Err.Number = 0 Then
　Workbooks.Open FName
Else
　MsgBox "現在、そのブックは編集可能ではありません。", 16
Exit Sub
End If
End Sub

お礼

ありがとうございます。
素人なりにやってみました。
（文中の16は意味が分からなかったので
記入しませんでした）
その結果、ファイルの有無、競合は
感知出来ていますが、難点があります。
Open FName For Binary Lock Write As #Fno
で、存在しないファイルが生成されてしまい、
Workbooks.Open FNameで、そのファイルを
開いています。
だから、「ファイルを生成しない」ことが、
要求されます。

回答No.2

AloneAgain

こんにちは。

他のユーザーが既に開いている場合、そのファイルは「読み取り専用」になります。
ですから、とりあえずいったんそのファイルを開き、
「読み取り専用」であれば既に開かれていると判断すればいいのではないでしょうか。

-------------------------------------------
Workbooks.Open FileName:=PathName & "\" & FileName
If ActiveWorkbook.ReadOnly Then
　　ActiveWorkbook.Close
　　MsgBox "他のユーザーが使用中です！"

End If
--------------------------------------------

お礼

ありがとうございます。
競合の判断には使用できますね。
しかし、「読み取り専用」の表示が
先に出てしまうし、この表示を阻止できないので
蛇足的なメッセージ表示になってしまいますね。
しようがないのかな？
ファイル更新しないように、
念押しのメッセージということで、
諦めようかなと思っています。

回答No.1

Wendy02

テストしたわけではないので、自信が持てませんが、こんなようになるかな？(たぶん)

Sub KUTest()
Dim Rtn As Long
Const FName As String = "サーバー\TEST.xls"
Rtn = GetAttr(FName) And vbReadOnly
If Rtn > 0 Then
　 MsgBox "現在、他の人がデータにアクセスしています。", vbInformation
　 Exit Sub
Else
　 Workbooks.Open FName
End If
End Sub

それから、
＞誤ったファイル名を指定した場合は、次のＶＢＡでメッセージを出せますが、

こちらは、私だったらこうかな？

Const PathName = "aa"
Const Filename = "bb"
If Dir(PathName & "\" & Filename) = "" Then
　 MsgBox "ファイルが見つかりません"
　 Exit Sub
End If
　Workbooks.Open Filename:=PathName & "\" & Filename

それから、別に、Const で定数にする必要はないですからね。単に、書く行を減らすためだけだったからです。

お礼

ありがとうございました。
プログラムの記述方法が適正でないかも
しれませんが
デバックモードで実行してみるとRtnに
ファイルが存在すると"0"、
ファイルが存在しないと""
の値が帰ってくるようです。
従って、競合の判断には使用できない
みたいです。