アプリ版:「スタンプのみでお礼する」機能のリリースについて

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

A 回答 (4件)

こんにちは。


>(文中の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
    • good
    • 1
この回答へのお礼

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

お礼日時:2005/06/07 17:00

すみませんが、もう一度試していただけませんか?


単に、バイナリ・オープンでロックして書き込めるかどうかをチェックするだけですが。

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
    • good
    • 0
この回答へのお礼

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

お礼日時:2005/06/03 12:04

こんにちは。



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

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

End If
--------------------------------------------
    • good
    • 0
この回答へのお礼

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

お礼日時:2005/06/02 16:24

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



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


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

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

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

それから、別に、Const で定数にする必要はないですからね。単に、書く行を減らすためだけだったからです。
    • good
    • 0
この回答へのお礼

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

お礼日時:2005/06/02 15:59

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています