Function Checking if a network file is open - not working as expected?

[samkeenan3]

Running in Excel 2016 on Win10:

I've been testing a workbook that will be used by several users to write data to a single workbook stored on a network. I am using a VBA function to checks that the network file is not already open before opening it, writing data in it, and saving and closing it.

The function is as follows and comes from this thread: VBA How to report which User has File Open?

Function IsFileOpen(strFullPathFileName As String) As Boolean

Dim hdlFile As Long

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:

IsFileOpen = True
Close hdlFile

End Function

When I run the function the first time and the workbook is not open, it works fine. However, on each subsequent time it will always return True (i.e workbook is open) - even when the workbook is verifiably not open.

Have I missed something obvious?

 

[dmt32]

Hi,
welcome to forum

try this updated version & see if works any better for you

Function IsFileOpen(ByVal FileName As String) As Boolean

    'dmt32 March 2021
    If Not Dir(FileName, vbDirectory) = vbNullString Then
        'check if file already open read/write
        On Error Resume Next
        Open FileName For Binary Access Read Lock Read As #1
        Close #1
        IsFileOpen = CBool(Err.Number > 0)
        On Error GoTo 0
    Else
        MsgBox "File / Folder Not Found", 48, "Not Found"
    End If
End Function

Dave

 

[samkeenan3]

Hi,
welcome to forum

try this updated version & see if works any better for you

Function IsFileOpen(ByVal FileName As String) As Boolean

    'dmt32 March 2021
    If Not Dir(FileName, vbDirectory) = vbNullString Then
        'check if file already open read/write
        On Error Resume Next
        Open FileName For Binary Access Read Lock Read As #1
        Close #1
        IsFileOpen = CBool(Err.Number > 0)
        On Error GoTo 0
    Else
        MsgBox "File / Folder Not Found", 48, "Not Found"
    End If
End Function

Dave

Dave thank you for this and for the speedy reply. Unfortunately, this is behaving the same way as the other function, running as expected first time around but not on subsequent runs where it always returns that the file is open even when it is not.

When I close the workbook containing the function it seems to "re-set" and will work correctly again (first time, but not thereafter.)

 

[dmt32]

Interesting, I have used this method over many years with no issues - as a guess, you may have a variable that is holding its value
can you share ALL the code you have that calls the function?

Dave

 

[samkeenan3]

Thank you again Dave.
I have 2 separate routines that call the function, both are in Userforms:

mastername is a Global string variable containing the full filename of the file I want to check is open

from first userform:

Public Sub CommandButton1_Click()
Dim xRet As Boolean

Dim fDate As String
Dim fReason As String
Dim findrow As Integer

Dim r1 As Integer
r1 = Sheets("My Tasks").Cells(1, 3).Value



fDate = ComboBox1.Value
fReason = ComboBox2.Value

Dim wbSource1 As Workbook, wbDest1 As Workbook
Dim wsSource1 As Worksheet, wsDest1 As Worksheet
Dim rngSource1 As Range, rngDest1 As Range


Set wbSource1 = ThisWorkbook
Set wsSource1 = wbSource1.Worksheets("My Tasks")

Application.ScreenUpdating = False


    If IsFileOpen(mastername) Then
        
        Application.ScreenUpdating = True
            Select Case MsgBox("The workbook is busy. Please try to Send again or Click Cancel to Exit without Sending", vbOKCancel + vbCritical, "Busy!!")
            
            Case vbOK
                Exit Sub
        
            Case vbCancel
                Unload Me
                End
                Exit Sub
       
            End Select
        
    
       
    Else 'not open - safe to write to
        
        Set wbDest1 = Workbooks.Open(mastername)
        Set wsDest1 = wbDest1.Worksheets("OPEN")
    
    End If





Unload Me
End

End Sub

from second userform:

Public Sub CommandButton2_Click() 
Dim xRet As Boolean

Dim cReason As String


Dim r1 As Integer
r1 = Sheets("My Tasks").Cells(1, 3).Value
cReason = ComboBox1.Value

Dim wbSource2 As Workbook, wbDest2 As Workbook
Dim wsSource2 As Worksheet, wsDest2 As Worksheet
Dim rngSource2 As Range, rngDest2 As Range


Set wbSource2 = ThisWorkbook
Set wsSource2 = wbSource2.Worksheets("My Tasks")

Application.ScreenUpdating = False


    If IsFileOpen(mastername) Then
        
        Application.ScreenUpdating = True
            Select Case MsgBox("The workbook is busy. Please try to Send again or Click Cancel to Exit without Sending", vbOKCancel + vbCritical, "Busy!!")
            
            Case vbOK
                Exit Sub
        
            Case vbCancel
                Unload Me
                End
                Exit Sub
       
            End Select
        
    
       
    Else 'not open - safe to write to
        
        Set wbDest2 = Workbooks.Open(mastername)
        Set wsDest2 = wbDest2.Worksheets("OPEN")
        Set wsDest3 = wbDest2.Worksheets("CLOSED")
    
    End If




Application.ScreenUpdating = True
Unload Me

End

End Sub

 

[dmt32]

Hi,

My initial thoughts were that you were passing the result of the function to a public variable that was retaining its value but looking at your code, seems not to be the case.

Code I provided is from a cut down version of one I have used over many years without any issue and I have no immediate thoughts as to why it is producing a constant True result for you - maybe another here could offer some insight.

This may not change your predicament but try using the full version of the function which negates the need for the msgbox code you have in your userforms as this is managed from within the function.



Place following code in a STANDARD module

Function OpenDatabase(ByVal FileName As String, Optional ByVal ReadOnly As Boolean, Optional ByVal Password As String) As Workbook
    Dim Response           As VbMsgBoxResult
    Dim FileInUse            As Boolean
'dmt32 May 2020
OpenFile:
    If Not Dir(FileName, vbDirectory) = vbNullString Then
        If Not ReadOnly Then
'check if file already open read/write
            On Error Resume Next
            Open FileName For Binary Access Read Lock Read As #1
            Close #1
            FileInUse = CBool(Err.Number > 0)
            On Error GoTo 0
            If FileInUse Then
'read / write file in use
                Response = MsgBox("File Is Open For Editing By Another User." & Chr(10) & _
                "Do You Want To Try Again?", 37, "File In Use")
                If Response = vbRetry Then
                    GoTo OpenFile
                Else
                    Set OpenDatabase = Nothing
                    Exit Function
                End If
            End If
        End If
        Set OpenDatabase = Workbooks.Open(FileName, ReadOnly:=ReadOnly, Password:=Password)
    Else
        MsgBox "File / Folder Not Found", 16, "Not Found"
        Set OpenDatabase = Nothing
    End If
End Function

Function allows you to optionally specify if file is to be opened ReadyOnly and provide a password to open the workbook.

And to call from your userforms

Public Sub CommandButton1_Click()
    Dim xRet        As Boolean
    Dim fDate       As String
    Dim fReason     As String
    Dim findrow     As Integer
    Dim wbSource1   As Workbook, wbDest1 As Workbook
    Dim wsSource1   As Worksheet, wsDest1 As Worksheet
    Dim rngSource1  As Range, rngDest1 As Range
    Dim r1          As Integer
  
    r1 = Sheets("My Tasks").Cells(1, 3).Value
  
    fDate = ComboBox1.Value
    fReason = ComboBox2.Value
  
    Set wbSource1 = ThisWorkbook
    Set wsSource1 = wbSource1.Worksheets("My Tasks")
  
    Set wbDest1 = OpenDatabase(mastername, False, mypassword)
    If wbDest1 Is Nothing Then Exit Sub
  
    Set wsDest1 = wbDest1.Worksheets("OPEN")
  
End Sub


Public Sub CommandButton2_Click()
    Dim xRet        As Boolean
    Dim cReason     As String
    Dim r1          As Integer
    Dim wbSource2   As Workbook, wbDest2 As Workbook
    Dim wsSource2   As Worksheet, wsDest2 As Worksheet
    Dim rngSource2  As Range, rngDest2 As Range
  
    r1 = Sheets("My Tasks").Cells(1, 3).Value
    cReason = ComboBox1.Value
  
    Set wbSource2 = ThisWorkbook
    Set wsSource2 = wbSource2.Worksheets("My Tasks")
  
    Set wbDest2 = OpenDatabase(mastername, False, mypassword)
    If wbDest2 Is Nothing Then Exit Sub
  
    Set wsDest2 = wbDest2.Worksheets("OPEN")
    Set wsDest3 = wbDest2.Worksheets("CLOSED")
  
End Sub

Hope Helpful

Dave

 

[dmt32]

I neglected to ask – your codes in userform only shows the opening of the workbook – I assume that you have code in your project to close it BEFORE the function is called again?

Dave

 

[samkeenan3]

Thanks so much Dave for your input.

I had the same experience with this function as with the previous functions. However, on passing the actual filepath through the function, rather than the global string mastername (which contained said filepat)h, it worked fine every time. So I "re-declared" mastername's value in each of the command button routines, immediately before passing it to the function, and now all is well. I don't understand why this should be case, but that is probably exposing my own ignorance!

Thanks again for your help, and I will continue to use your OpenDatabase functionif that's OK, as I think it's the most versatile and elegant of the ones I've seen.

 

[dmt32]

Thanks again for your help, and I will continue to use your OpenDatabase functionif that's OK, as I think it's the most versatile and elegant of the ones I've seen.

Hi glad you have managed to resolve & appreciate you kind comment about my little function which I created about 10 years ago for timesheet application I developed for charity my daughter worked for where 250 people would submit their weekly timesheet data to a common workbook (database) & it seemed to perform without issue.

Good luck with your project

Dave