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,
 

Some videos you may like

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

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!!
 

Watch MrExcel Video

Forum statistics

Threads
1,123,337
Messages
5,601,026
Members
414,422
Latest member
acegreen

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