Check if File is Open

[taltyr]

On the current Workbook I have a button, it runs the code below.

Ideally the user would be given the instruction to select the latest "ECHIT" workbook. If it is not open, Excel will open it, refresh a Pivot Table and copy the data back into the current Workbook. If it is open, Excel should activate that open file and do the same refresh, copy, paste exercise.

I have managed to get most of it to work, it is just the file open/ not open alternatives that I have difficulty with.

The code I have so far is;

Sub UpdateFile()
Dim strThisWorkbook
'Dim ECHIT As String
strThisWorkbook = ThisWorkbook.Name
MsgBox "Select up-to-date ECHIT Schedule"
ECHIT = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Please select a file")
If ECHIT = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
Exit Sub
Else
    If Not IsFileOpen("ECHIT") Then
        Workbooks.Open FileName:=ECHIT
 
        Else
        Workbooks("ECHIT").Activate
 
    End If
'Workbooks.Open FileName:=ECHIT
'MsgBox ECHIT
   ' Workbooks(ECHIT).Activate
    'Workbooks.Activate Filename:=ECHIT
    Sheets("EXPORT").Select
    ActiveSheet.PivotTables("PivotTable1").PivotSelect _
        "'Budget aligned Contract Number'[All]", xlLabelOnly + xlFirstRow, True
    Application.CutCopyMode = False
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
    Cells.Select
    Selection.Copy
    'ActiveWindow.Close
    Windows(strThisWorkbook).Activate
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
End Sub
Function IsFileOpen(FileName As String)
    Dim iFilenum As Long
    Dim iErr As Long
 
    On Error Resume Next
    iFilenum = FreeFile()
    Open FileName For Input Lock Read As #iFilenum
    Close iFilenum
    iErr = Err
    On Error GoTo 0
 
    Select Case iErr
    Case 0:    IsFileOpen = False
    Case 70:   IsFileOpen = True
    Case Else: Error iErr
    End Select
 
End Function

As ever any help greatly appreciated.

taltyr

 

[Richard Schollar]

Do you want to know if the file is open on your computer or on any computer?

 

[taltyr]

Good Question, hadn't thought of that.

Now that you ask, in an ideal world, what I would like is;

If it is open on another computer I would get a Yes/ No Box Message asking me if it was OK to use that file already open file on another users PC.

AND

If it is open on my computer I would get a Yes/ No Box Message asking me if it was OK to use that already open file on my PC.

Bit of an expanded question I know, but like I say I hadn't thought of it.

Regards

Taltyr

 

[Richard Schollar]

The function you have is fine - you just need to change this bit:

If Not IsFileOpen("ECHIT") Then   
        Workbooks.Open FileName:=ECHIT
 
        Else
        Workbooks("ECHIT").Activate
 
    End If

to this:

Dim wb As Workbook

If Not IsFileOpen(ECHIT) Then    '=====Note no quotes!
        Workbooks.Open FileName:=ECHIT
 
        Else
            On Error Resume Next
            Set wb = Workbooks(Mid(ECHIT,InstrRev(ECHIT,"\")+1))
            On Error Goto 0
            If wb Is Nothing Then
                 If MsgBox("ECHIT workbook open on another computer or in another Excel session on this computer! Open it up anyway?",vbYesNo) = vbYes Then
                       Set wb = Workbooks.Open(Filename:=ECHIT,ReadOnly=True)
                 Else
                     Exit Sub
                 End If
            Else
                  Workbooks(Mid(ECHIT,InstrRev(ECHIT,"\")+1)).Activate
            End if
 
    End If

 

[taltyr]

Thanks so far.

When I run it I get a Compile error: ByRef argument type mismatch on the 1st line

If Not IsFileOpen(ECHIT) Then    '=====Note no quotes!

The line

Set wb = Workbooks.Open(Filename:=ECHIT,ReadOnly=True)

is also showing in red but not sure what the error is there.

Regards

Talty

 

[Richard Schollar]

Change the definition of the function (1st line) to:

Function IsFileOpen(ByVal FileName As String)

amendment in red.

Change that other line to:

Set wb = Workbooks.Open(Filename:=ECHIT,ReadOnly:=True)

also in red

 

[taltyr]

For some reason it does not pick up that the file is open and skips to the Else bit of the If statement.

To be sure, this is the code I now have;

Sub UpdateFile()
Dim strThisWorkbook
'Dim ECHIT As String
Dim wb As Workbook
strThisWorkbook = ThisWorkbook.Name
MsgBox "Select up-to-date ECHIT Schedule"
ECHIT = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Please select a file")
If ECHIT = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
Exit Sub
Else

If Not IsFileOpen(ECHIT) Then    '=====Note no quotes!
        Workbooks.Open FileName:=ECHIT
 
        Else
            On Error Resume Next
            Set wb = Workbooks(Mid(ECHIT, InStrRev(ECHIT, "\") + 1))
            On Error GoTo 0
            If wb Is Nothing Then
                 If MsgBox("ECHIT workbook open on another computer or in another Excel session on this computer! Open it up anyway?", vbYesNo) = vbYes Then
                       Set wb = Workbooks.Open(FileName:=ECHIT, ReadOnly:=True)
                 Else
                     Exit Sub
                 End If
            Else
                  Workbooks(Mid(ECHIT, InStrRev(ECHIT, "\") + 1)).Activate
            End If
 
    End If
'Workbooks.Open FileName:=ECHIT
'MsgBox ECHIT
   ' Workbooks(ECHIT).Activate
    'Workbooks.Activate Filename:=ECHIT
    Sheets("EXPORT").Select
    ActiveSheet.PivotTables("PivotTable1").PivotSelect _
        "'Budget aligned Contract Number'[All]", xlLabelOnly + xlFirstRow, True
    Application.CutCopyMode = False
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
    Cells.Select
    Selection.Copy
    'ActiveWindow.Close
    Windows(strThisWorkbook).Activate
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
End Sub
Function IsFileOpen(ByVal FileName As String)
    Dim iFilenum As Long
    Dim iErr As Long
     
    On Error Resume Next
    iFilenum = FreeFile()
    Open FileName For Input Lock Read As #iFilenum
    Close iFilenum
    iErr = Err
    On Error GoTo 0
     
    Select Case iErr
    Case 0:    IsFileOpen = False
    Case 70:   IsFileOpen = True
    Case Else: Error iErr
    End Select
     
End Function

 

[Richard Schollar]

Where do you have the file open?

 

[taltyr]

I have it open in the same place as the current Workbook (on my Laptop from My Documents).

I see that, on going through the function, it does select Case 70 as expected.


Regards

taltyr

 

[Richard Schollar]

It worked for me as I expected it to - if the workbook was open in the same Excel session as that running the code, the workbook was activated. Have you turned off ScreenUpdating? That may prevent you seeing that this has happened.