Office: VBA Hilfe Abfrage ob Datei vom anderen User geöffnet ist

Hallo zusammen,

ich habe hier in einer Datei einen Code der immer problemlos funktioniert hat für Dateien mit der Endung . xls.
Nun möchte ich mit diesem Makro auch Dateien mit der Endung .xlsm überprüfen.

Hier bekomme ich die Fehlermeldung: Laufzeitfehler 6: Überlauf

Hier das Makro:

Sub Report()
Dim strDatei As String
Dim strUser As String
strDatei = "Report.xlsm"
If IsFileOpen(strDatei) Then
strUser = WorksheetFunction.Proper(LastUser(strDatei))
If MsgBox("Datei wird bereits von (" & strUser & ") bearbeitet, Datei schreibgeschützt öffnen?", vbYesNo, "Frage") = vbNo Then
Exit Sub
Else
Workbooks.Open filename:=strDatei
End If
Else
Workbooks.Open filename:=strDatei
End If
End Sub


Public Function LastUser(strPath As String) As String
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
For i = j - 1 To 1 Step -1
If Mid(strXl, i, 1) = Chr(0) Then Exit For
Next
i = i + 1
#Else
i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
#End If
lNameLen = Asc(Mid(strXl, i - 3, 1))
LastUser = Mid(strXl, i, lNameLen)
End Function


Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
IsFileOpen = False
Case 70
IsFileOpen = True
Case Else
Error errnum
End Select
End Function


Wäre nett, wenn mir da jemand weiterhelfen könnte, vielen Dank!

Grüße

 

Hallo,

habe es mit einer XLSM-Datei ausprobiert. Der Schreibschutz-Auslese-Mechanismus klappt, wobei Du im Code hier oben keinen Pfad an strDatei übergibst. Die Prozedur LastUser() kann mit neuen Dateien (XSLM sind letztlich Zip-Dateien und keine Binärdateien wie XLS) nicht funktionieren. Eine Alternative habe ich nicht parat, aber wenn Du das mal ausklammert, hast Du dann den Fehler auch?

Gruß

 

Ja den kompletten Dateipfad habe ich absichtlich nicht angegeben.
Der Code funktioniert auch problemlos.

Nur eben nicht, wenn ich die eine xlsm Datei abfrage. Da bekomme ich den oben benannten Fehler.
Dafür gibt es keine Lösung? Ich würde die DAteien eigentlich gerne als xlsm Datei lassen, da sie kleiner sind.

DAnke und Gruß

 

Hallo,
ich habe dazu eine Frage und zwar wäre es möglich abzufragen, ob eine UserForm irgendwo geöffnet ist?
Kollegen und ich arbeiten in einer Excel Arbeitsmappe und zur Zeit können alle gleichzeitig eine Userform öffnen. Dies würden wir gerne verbieten.
VBA Hilfe Abfrage ob UserForm vom anderen User geöffnet ist (office-hilfe.com)