Gruppe
Datei
Problem
Es soll festgestellt werden, ob auf eine Netzwerkdatei von einem anderen Anwender zugegriffen wird.
StandardModule: Modul1
Sub TestFileOpen()
Dim iOpen As Integer
Dim sFile As String
sFile = InputBox("Path and Filename:", , "c:\test\test.xls")
If sFile = "" Then Exit Sub
iOpen = TestOpen(sFile)
Select Case iOpen
Case 0: MsgBox "Datei " & sFile & " ist frei"
Case 1: MsgBox "Datei " & sFile & " ist geöffnet"
Case 2: MsgBox "Datei " & sFile & " wurde nicht gefunden"
End Select
End Sub
Private Function TestOpen(sPath As String) As Integer
If Dir(sPath) = "" Then
TestOpen = 2
Else
On Error GoTo ERRORHANDLER
Open sPath For Random Access Read Lock Read Write As #1
Close #1
End If
ERRORHANDLER:
If Err = 70 Then TestOpen = 1
End Function