Check if File is Already Open

[seenfresh]

I have the following Code to Check if a File is already Open.... and perform a procedure

Basically if file is already open then perform procedure... If file is not already open open it and then run the procedure...

For some reason this part:

If IsFileOpen(sPath) Then

MsgBox "File is Open"
GoTo ResumeProcess:

Does not work shen the file is already open... I get run time error 1004 stating the file is already open...

I was hoping I would not receive any errors if file is already open and then just resume normal activity...

Private Sub CommandButton2_Click()

Dim WbBook1 As Worksheet
Dim WbBook2 As Worksheet
Dim sPath As String
sPath = "\\Nymas01\finance\Budget\Budget 2008\Exports\PLATFORM.xls"

If IsFileOpen(sPath) Then

MsgBox "File is Open"
GoTo ResumeProcess:

Else



Workbooks.Open (sPath)

End If


ResumeProcess:

Set WbBook1 = Workbooks("PLATFORM.xls").Worksheets("PLATFORM")
Set WbBook2 = Workbooks("License Fees_2008.xls").Worksheets("PLATFORM not in FRX")


WbBook2.Range("A2:A" & Rows.Count).Formula = "=IF(ISBLANK(GROUPLIST!A3)," & Chr(34) & Chr(34) & ",IF(COUNTIF(PLATFORM.xls!$B:$B,GROUPLIST!A3)>0," & Chr(34) & Chr(34) & ",GROUPLIST!A3))"
'Dim eSheet As Worksheet
'Set eSheet = Sheets("PLATFORM not in FRX")

'x = eSheet.Rows.Count

'eSheet.Range("A2").Formula = "=IF(ISBLANK(GROUPLIST!A3),"",IF(COUNTIF(PLATFORM.xls!$B:$B,GROUPLIST!A3)>0,"",GROUPLIST!A3))"
'eSheet.Range("A2:A" & x).FillDown

Workbooks("PLATFORM.xls").Close
End Sub
Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.

    ' Check to see which error occurred.
    Select Case errnum

        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
         IsFileOpen = False

        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = True

        ' Another error occurred.
        Case Else
            Error errnum
    End Select

End Function

Any advice in this matter would be amazing!

Thanks in advance,

 

[VoG]

Try

On Error Resume Next
Workbooks.Open sPath
On Error GoTo 0

 

[seenfresh]

reply

Vog II

Thank you!

I adjusted the code to suit your suggestion as follows and it works fine:

Private Sub CommandButton2_Click()

Dim WbBook1 As Worksheet
Dim WbBook2 As Worksheet
Dim sPath As String
sPath = "\\Nymas01\finance\Budget\Budget 2008\Exports\PLATFORM.xls"

If IsFileOpen(sPath) Then

MsgBox "File is Open"
GoTo ResumeProcess:

Else



 On Error Resume Next
Workbooks.Open sPath
On Error GoTo 0

End If


ResumeProcess:

Set WbBook1 = Workbooks("PLATFORM.xls").Worksheets("PLATFORM")
Set WbBook2 = Workbooks("License Fees_2008.xls").Worksheets("PLATFORM not in FRX")


WbBook2.Range("A2:A" & Rows.Count).Formula = "=IF(ISBLANK(GROUPLIST!A3)," & Chr(34) & Chr(34) & ",IF(COUNTIF(PLATFORM.xls!$B:$B,GROUPLIST!A3)>0," & Chr(34) & Chr(34) & ",GROUPLIST!A3))"
'Dim eSheet As Worksheet
'Set eSheet = Sheets("PLATFORM not in FRX")

'x = eSheet.Rows.Count

'eSheet.Range("A2").Formula = "=IF(ISBLANK(GROUPLIST!A3),"",IF(COUNTIF(PLATFORM.xls!$B:$B,GROUPLIST!A3)>0,"",GROUPLIST!A3))"
'eSheet.Range("A2:A" & x).FillDown

Workbooks("PLATFORM.xls").Close
End Sub
Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.

    ' Check to see which error occurred.
    Select Case errnum

        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
         IsFileOpen = False

        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = True

        ' Another error occurred.
        Case Else
            Error errnum
    End Select

End Function

Thanks again!!