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

 

[taltyr]

OK, Now I understand what is is doing.

Is it possible to get the YES/ NO Option even when it is in the same EXCEL Session?

Regards

Rodger

 

[Richard Schollar]

Ok but what question is being asked: if the workbook is open, what possible outcomes are there? Use the open workbook or exit sub?

 

[taltyr]

Yes.

I want to let them use it or exit the sub and confirm that the ECHIT opened is uptodate.

Also if it is open on another PC but not yet saved the information will not be correct.

Thanks for your time on this.

Regards

taltyr

 

[Richard Schollar]

Try this:

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
                 If MsgBox("ECHIT workbook already open in this Excel session on this computer! Exit sub?", vbYesNo) = vbYes Then
                     Exit Sub
                 Else
                    Workbooks(Mid(ECHIT, InStrRev(ECHIT, "\") + 1)).Activate
                 End if
            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

Hopefully this does what you want - come back to me if I haven't got it right

 

[taltyr]

Yes, that's perfect.

Thanks for your time.

Regards

taltyr