VBA code for opening and closing excel file provided not already open

[nomissmith]

I have two excel spreadsheets that are linked to show data from one in the other. Due to the fact that I am using COUNTIFS, SUMIFS and a MAX(IF) in order to check multiple criteria the worksheet that displays the linked data requires the spreadsheet containing the data to be opened to update. The file does not need to stay open so I have put a macro in to open, save and close the required file. Unfortunately it appears that if the file is already open it will save the opened file to another location and this changes all the data links on the second spreadsheet.

Is there a way of checking whether the file is open and doing the following depending on found condition;

1. If open - display a message saying unable to update as file already open.
2. If closed - complete open, save, close macro

I currently have the macro linked to a button.

 

[Gerald Higgins]

Hi, welcome to the board.

Do you really need to save the file ?
What happens if you just open it, do whatever you need to do with it, and then close it again without saving ?

 

[Fishboy]

I have two excel spreadsheets that are linked to show data from one in the other. Due to the fact that I am using COUNTIFS, SUMIFS and a MAX(IF) in order to check multiple criteria the worksheet that displays the linked data requires the spreadsheet containing the data to be opened to update. The file does not need to stay open so I have put a macro in to open, save and close the required file. Unfortunately it appears that if the file is already open it will save the opened file to another location and this changes all the data links on the second spreadsheet.

Is there a way of checking whether the file is open and doing the following depending on found condition;

1. If open - display a message saying unable to update as file already open.
2. If closed - complete open, save, close macro

I currently have the macro linked to a button.

Hi nomissmith, welcome to the boards.

You can use a combination of the following codes found directly from the Microsoft support pages.

Firstly you will need to add this User Defined Function to a standard module:

Function IsFileOpen(filename As String)
' Defines variables
    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

Once the UDF has been added to your document you can modify this macro to suit your requirements. In effect this macro calls the UDF and tests if a file is already open or not. If the file is open it can give you a message and exit the sub, however if the file is not open then it will do something else. That something else can basically be your existing code. Remember to change the bold red parts to suit the correct filepath / filename. You can put the rest of your code where the purple comment is.

Sub TestFileOpened()


    ' Test to see if the file is open.
    If IsFileOpen("C:\testfolder\Opened.xlsm") Then
        ' Display a message stating the file in use.
        MsgBox "File already in use!"
            Exit Sub
    Else
        ' Display a message stating the file is not in use.
        MsgBox "File not in use!"
        ' Open the file
        Workbooks.Open "C:\testfolder\Opened.xlsm"
            ' The rest of your code goes here
            '
            '
    End If


End Sub

 

[nomissmith]

Hi nomissmith, welcome to the boards.

You can use a combination of the following codes found directly from the Microsoft support pages.

Firstly you will need to add this User Defined Function to a standard module:

Function IsFileOpen(filename As String)
' Defines variables
    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

Once the UDF has been added to your document you can modify this macro to suit your requirements. In effect this macro calls the UDF and tests if a file is already open or not. If the file is open it can give you a message and exit the sub, however if the file is not open then it will do something else. That something else can basically be your existing code. Remember to change the bold red parts to suit the correct filepath / filename. You can put the rest of your code where the purple comment is.

Sub TestFileOpened()


    ' Test to see if the file is open.
    If IsFileOpen("C:\testfolder\Opened.xlsm") Then
        ' Display a message stating the file in use.
        MsgBox "File already in use!"
            Exit Sub
    Else
        ' Display a message stating the file is not in use.
        MsgBox "File not in use!"
        ' Open the file
        Workbooks.Open "C:\testfolder\Opened.xlsm"
            ' The rest of your code goes here
            '
            '
    End If


End Sub

Thank you so much - it worked perfectly

 

[Fishboy]

Thank you so much - it worked perfectly

Whilst I can't take credit for the code (it was just on the Microsoft support site), I will gladly take credit for my Google-fu

Happy to hear you got it working as required, and thanks for the positive feedback.