Check if File is Already Open

seenfresh

Well-known Member
Joined
Jul 12, 2006
Messages
1,141
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...


Code:
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,
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
Try

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

seenfresh

Well-known Member
Joined
Jul 12, 2006
Messages
1,141
reply

Vog II

Thank you!

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

Code:
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!!
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,389
Messages
5,836,972
Members
430,464
Latest member
nickburrett

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top