Replies

You may have inadvertenly turned it off by clearing the status bar area ….
You can try turning it back on via code.

Application.StatusBar = False

Ok try this amended code


Sub TestVBA()
'// 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

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


The Username code works on the fact that a workbook opened by a User gets certain info written to it
eg Username. What this code does is to search the file for 2 consecutive spaces chr(32) and works backwards from that possition
until the End of string disignator = 2 vbnullstrings. The character just before this is actually the length of the Username.

Ok try this amended code


Sub TestVBA()
'// 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

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


The Username code works on the fact that a workbook opened by a User gets certain info written to it
eg Username. What this code does is to search the file for 2 consecutive spaces chr(32) and works backwards from that possition
until the End of string disignator = 2 vbnullstrings. The character just before this is actually the length of the Username.

This Worked for me Xl2003 / WinXp

Sub TestVBA()
'// 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"
        MsgBox ActiveWorkbook.WriteReservedBy
    Else
        MsgBox strFileToOpen & " is not open"
        MsgBox ActiveWorkbook.WriteReservedBy
    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
'// 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

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 & Mike for the idea
Dim text As String
Dim strFlag1 As String, strflag2 As String
Dim i As Integer, j As Integer

strFlag1 = Chr(0) & Chr(0)
strflag2 = Chr(32) & Chr(32)

Open strPath For Binary As #1
    text = Space(LOF(1))
    Get 1, , text
Close #1
j = InStr(1, text, strflag2)
i = InStrRev(text, strFlag1, j) + Len(strFlag1)
LastUser = Mid(text, i, j - i)

End Function

This Worked for me Xl2003 / WinXp

Sub TestVBA()
'// 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"
        MsgBox ActiveWorkbook.WriteReservedBy
    Else
        MsgBox strFileToOpen & " is not open"
        MsgBox ActiveWorkbook.WriteReservedBy
    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
'// 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

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 & Mike for the idea
Dim text As String
Dim strFlag1 As String, strflag2 As String
Dim i As Integer, j As Integer

strFlag1 = Chr(0) & Chr(0)
strflag2 = Chr(32) & Chr(32)

Open strPath For Binary As #1
    text = Space(LOF(1))
    Get 1, , text
Close #1
j = InStr(1, text, strflag2)
i = InStrRev(text, strFlag1, j) + Len(strFlag1)
LastUser = Mid(text, i, j - i)

End Function

Yes, and I stated that when posting.

Original Q was
” need to extract a filename from a string…..”

Yes, and I stated that when posting.

Original Q was
” need to extract a filename from a string…..”

MsgBox Dir(“C:ExcelFilesHelpactionscript_dict.pdf”)

Will yield the File name if it exists

MsgBox Dir(“C:ExcelFilesHelpactionscript_dict.pdf”)

Will yield the File name if it exists

The above Requires
shell32.dll version 4.71 or later
Minimum operating systems: Windows

Hyperlinks added- Mod

Hi Alan

You are probably missing the IeTimer……

It’s available at;

http://activex.microsoft.com/controls/iexp…x86/ietimer.cab%5B/url%5D

(After download it has to be registered with regsvr32)
You can use the Regsvr32 tool (Regsvr32.exe) to register and unregister
object linking and embedding (OLE) controls such as dynamic-link
library (DLL) or ActiveX Controls (OCX) files that are
self-registerable.

Windows Taskbar
Click > Start
> Run
Typein > Regsvr32 ietimer.ocx

If not successfull here then try explicitly
setting the paths eg.

CWindowsSystemRegsvr32 C:WindowsSystemietimer.ocx

Regsvr32.exe is included with Microsoft Internet Explorer 3.0 or later,
Windows 95 OEM Service Release 2 (OSR2) or later,
and Windows NT 4.0 Service Pack 5 (SP5) or later.
Regsvr32.exe is installed in the System (Windows Me/98/95) or System32 (Windows NT) folder.