Abfrage Ob und Wer hat datei Offen
12.04.2022 06:47:02
Tony
ich habe mir da eine Abfrage für eine Userform zurecht "gebastelt" die auslesen soll ob die Datei bereits geöffnet ist oder nicht.
Leider scheint der aber den Teil zu "überlesen" das die Datei bereits offen ist. Ich habe die Datei Testweise auf einem anderen PC geöffnet und leider kommt immerzu die Meldung dass die Datei aktuell nicht in Benutzung ist und somit geöffnet werden kann.
Vielleicht sieht ja jemand auf Anhieb wo das Problem liegt.
Lieber Gruss und Merci
Tony
Option Explicit
Function GetFileOwner(fileDir As String, fileName As String) As String
'On Error Resume Next
Dim secUtil As Object
Dim secDesc As Object
Set secUtil = CreateObject("ADsSecurityUtility")
Set secDesc = secUtil.GetSecurityDescriptor(fileDir & fileName, 1, 1)
GetFileOwner = secDesc.owner
End Function
Public Function IsFileLocked(strFileName As String) As Boolean
On Error Resume Next
Dim FF As Integer
FF = FreeFile
'An error occurs if the document is currently open.
Open strFileName For Binary Access Read Lock Read As #FF
Close #FF
'Check for Error
If Err.Number Then
Err.Clear
IsFileLocked = True
End If
End Function
Public Sub Materialbtn_Click()
Dim PfadMat As String, DateiMat As String
Dim UsedBy As String
PfadMat = "X:\Werkstatt\Allgemein\Werkstatt Tool\Data\"
DateiMat = "Material.xlsm"
If IsFileLocked(DateiMat) = True Then
'Farbe wird nur zum Testen kurz eingesetzt
Materialbtn.BackColor = RGB(251, 2, 0)
'Spätere Message: "Die Datei ist in Benutzung durch" & UsedBy
MsgBox "Die Datei ist in Benutzung durch " & GetFileOwner(PfadMat, DateiMat) & "."
Else
MsgBox "Die Datei ist nicht in Benutzung."
'Farbe wird nur zum Testen kurz eingesetzt
Materialbtn.BackColor = RGB(3, 199, 97)
'Workbooks.Open "X:\Werkstatt\Allgemein\Werkstatt Tool\Data\Material.xlsm"
End If
'Startseite_Form.Hide
End Sub