How's it going, Noob?
The instructions at xcelfiles.com had a fundtion to check if the file was open on the network, rather than just on the host computer, which is what I needed. I tested the macro, and it worked IF the filename was a constant. When I tried to change the filename to a variable I got an error, "Compile Error: Constant Expression Required". Then if I try to Dim the statement "strFileToOpen" to either a workbook or a string, I get the error "Complie Error: Object required."
Here's the code as I'm trying to use it, I annotated out the oritginal code at the top.
Option Explicit
Sub TestVBA()
'The line below was the original code
'Const strFileToOpen As String = "C:\Data.xls"
'Here's how I've tried to change it
Dim strFileToOpen As String
Set strFileToOpen = "M:\PO Response Tracking - " & Range("B2").Value & ".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
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
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
Any suggestions on how I can modify this routine for my purposes?
Bookmarks