LastUser

[Bagsy]

Can anybody help with this please
With some code I have picked up on this board (with thanks IFM & others) I have managed to cobble some code together that checks if any files are open in a directory & names the file.
The last part, where it should give the name of the user who has a file open is giving me some grief.
I keep getting an “invalid procedure, call or argument” error, with this line highlighted.
i = InStrRev(strWholeFile, strFlag1, j) + Len(strFlag1)

I have tried changing various lines of the code, but have not been able to get it to run.

Option Explicit


Public myDir As String
Public StartLine As Long
Public HowManyLines As Long
Public myFile
Public i
Public adate
Public ws
Public ActWork
Public NewWrkBk
Dim Ans As Integer

Sub CheckIfOpen()

Set ActWork = ActiveWorkbook

Worksheets("Sheet1").Select
myDir = "G:\02. Stock Lists\Current Stock lists\"
myFile = Dir(myDir & Application.PathSeparator & "*.xls", vbDirectory)
'Clear Data in Column A & G
Range("A1:A100").ClearContents
Range("G1:G100").ClearContents
Range("A1").Select

i = 0
Do While myFile <> ""
i = i + 1
Cells(i, 1) = myFile
myFile = Dir
Loop

For i = 1 To Range("A65536").End(xlUp).Row

myFile = Cells(i, 1)

'// We can use this for ANY FILE not just Excel!
    If IsFileOpen(myDir & myFile) Then
        Ans = MsgBox(myFile & " is already Open" & _
            vbCrLf & "By " & LastUser("myDir.xls"), vbQuestion + vbOKOnly, "File in Use")
        Select Case Ans
        Case vbOK
   End
      
End Select
    End If
Next

End Sub

Function IsFileOpen(strFullPathFileName As String) As Boolean

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

This is the part of the code I am stuck on

Function LastUser(strFileName As String) As String
     
    Dim strWholeFile As String
    Dim strFlag1 As String, strFlag2 As String
    Dim intNameLength As Integer
    Dim i As Integer, j As Integer
     
    strFlag1 = Chr(0) & Chr(0)
    strFlag2 = Chr(32) & Chr(32)
     
    Open strFileName For Binary As #1
    strWholeFile = Space(LOF(1))
    Get 1, , strWholeFile
    Close #1
     
    j = InStr(1, strWholeFile, strFlag2)
    i = InStrRev(strWholeFile, strFlag1, j) + Len(strFlag1)
    intNameLength = Asc(Mid(strWholeFile, i - 3, 1))
    LastUser = Mid(strWholeFile, i, intNameLength)
     
End Function

 

[Bagsy]

Bump
Anybody got any views on this please?
The LastUser Function is where I am having a problem
It would be appreciated

 

[LizHill]

I know this is an old thread but I'm also having problems with this, the code works fine but the username returns garbage. I'm using Excel 2007 - anyone know how to fix it or have any other examples? I want Excel to to tell me when the file is already open and give me the name of the person who has it open.

Option Explicit
'===========================================
'http://www.xcelfiles.com/IsFileOpenVBA.htm
'===========================================
Sub TestVBA()
'// Just change the file to test here
Const strFileToOpen As String = "S:\Daily Data.xlsm"
    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
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
'// [URL]http://www.xcelfiles.com[/URL]
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 [URL]http://www.visualbasicforum.com/index.php?s[/URL]=
'// 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 Long, j As Long
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

Thanks