Datei geöffnet von wem

Public Function IsFileOpen(ByRef Path As String) As Boolean Dim FileNr As Integer Dim ErrorNr As Long 'open file for testing On Error Resume Next FileNr = FreeFile Open Path For Input Lock Write As #FileNr ErrorNr = Err.Number Close #FileNr On Error GoTo 0 If ErrorNr 0 Then IsFileOpen = True End If Err.Clear End Function

Public Sub CheckIfOpen() Dim BlockUser As String If IsFileOpen("L:\Test\test.xls") = True Then 'hier fehlt mir die Ermittlung des users MsgBox ("Die Datei wird von User " & BlockUser & " blockiert!") End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Theo,
habe folgende Quelle anzubieten : http://www.xcelfiles.com/IsFileOpen.html
Problem : Funktioniert nicht bei passwortgeschützten Dateien.
P.S Das "Private" bei

Sub TestVBA()

und bei

Function IsFileOpen(strFullPathFileName As String) As Boolean

habe ich ebenfalls nur eingfügt damit die Forumssoftware das Sub auch als Makro formatiert. Muss/Kann daher gelöscht werden.
Gruß
Mexsalem
Option Explicit

Private Sub TestVBA()
'http://www.xcelfiles.com/IsFileOpenVBA.htm
'// Just change the file to test here
Const strFileToOpen As String = "C:\Data.xls"
If IsFileOpen(strFileToOpen) Then
MsgBox strFileToOpen & " is already Open" & _
vbCrLf & "By " & LastUser(strFileToOpen), vbInformation, "File in Use"
Else
MsgBox strFileToOpen & " is not open", vbInformation
End If
End Sub

Private Function IsFileOpen(strFullPathFileName As String) As Boolean
'// VBA version to check if File is Open
'// We can use this for ANY FILE not just Excel!
'// Ivan F Moala
'// http://www.xcelfiles.com
Dim hdlFile As Long
'// Error is generated if you try
'// opening a File for ReadWrite lock >> MUST BE OPEN!
On Error GoTo FileIsOpen:
hdlFile = FreeFile
Open strFullPathFileName For Random Access Read Write Lock Read Write As hdlFile
IsFileOpen = False
Close hdlFile
Exit Function
FileIsOpen:
'// Someone has it open!
IsFileOpen = True
Close hdlFile
End Function

Private Function LastUser(strPath As String) As String
'// Code by Helen from http://www. _
visualbasicforum.com/index.php?s=
'// This routine gets the Username of the File In Use
'// Credit goes to Helen for code & Mark for the idea
'// Insomniac for xl97 inStrRev
'// Amendment 25th June 2004 by IFM
'// : Name changes will show old setting
'// : you need to get the Len of the Name stored just before
'// : the double Padded Nullstrings
Dim strXl As String
Dim strFlag1 As String, strflag2 As String
Dim i As Integer, j As Integer
Dim hdlFile As Long
Dim lNameLen As Byte
strFlag1 = Chr(0) & Chr(0)
strflag2 = Chr(32) & Chr(32)
hdlFile = FreeFile
Open strPath For Binary As #hdlFile
strXl = Space(LOF(hdlFile))
Get 1, , strXl
Close #hdlFile
j = InStr(1, strXl, strflag2)
#If Not VBA6 Then
'// Xl97
For i = j - 1 To 1 Step -1
If Mid(strXl, i, 1) = Chr(0) Then Exit For
Next
i = i + 1
#Else
'// Xl2000+
i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
#End If
'// IFM
lNameLen = Asc(Mid(strXl, i - 3, 1))
LastUser = Mid(strXl, i, lNameLen)
End Function

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread