Can you please help me figure this out?
I need to run some code on a workbook (A) to open couple other workbooks (B, C, D, & E) on the network. And these other workbooks are constantly being used by other people. So I have no problem opening these other workbooks... If these workbooks are currently being used by other people it will open as read only.
My problem is if I have any of these workbooks (B, C, D, & E) opened on my computer. The code will attempt to reopen these workbooks, and this will trigger a message saying this:
"B.xlsm is already open. Reopening will cause any changes you made to be discarded. Do you want to reopen B.xlsm?"
Click YES will close existing workbooks (B) without saving and reopen it. Click NO will pop up this Run-time error' 1004": Method 'Open of object Workbooks' failed.
How do I alter this code so that if workbooks (B, C, D, & E) is opened on my computer (Opened by me and not Read only), it will continue the code without re-opening it?
Can you geniuses please help me figure this out ???
My Code:
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
Sub test2()
Dim FolderPath As String
Dim filePath As String
Dim wBook As String
FolderPath = Application.ActiveWorkbook.Path
filePath = Left(FolderPath, InStrRev(FolderPath, "\") - 1)
wBook = filePath & "\Appeals 01.xlsm"
'If Workbook is Opened
If IsWorkBookOpen(filePath & "\Appeals 01.xlsm") Then
If MsgBox("Appeal 01 is Opened. Do you want to open workbook as Read only?" & vbNewLine & vbNewLine & _
"Warning!!! Running numbers on Read-only mode can cause report not total correctly", vbYesNo, "Already Opened") = vbNo Then Exit Sub
Workbooks.Open FileName:=filePath & "\Appeals 01.xlsm"
Else
Workbooks.Open FileName:=filePath & "\Appeals 01.xlsm"
End If
MsgBox ("Continue Code")
End Sub
Hope you could help me... Thank you guys :)
Updated: Thanks to Tbizzness, I have revised my code to this:
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
Sub test2()
Dim FolderPath As String
Dim filePath As String
Dim wBook As String
FolderPath = Application.ActiveWorkbook.Path
filePath = Left(FolderPath, InStrRev(FolderPath, "\") - 1)
wBook = filePath & "\Appeals 01.xlsm"
'Set Boolean to True if it's open on my computer
For Each WB1 In Application.Workbooks
If WB1.Name = "Appeals 01.xlsm" Then
Appeal01bool = True
ElseIf WB1.Name = "Appeals 02.xlsm" Then
Appeal02bool = True
End If
Next
'If Appeal 01.xlsm is not open on my computer
If Appeal01bool = False Then
'Then is it opened by others
If IsWorkBookOpen(filePath & "\Appeals 01.xlsm") Then
'If it is opened by others, do you want to open as Read-only?
If MsgBox("Appeal 01 is Opened. Do you want to open workbook as Read only?" & vbNewLine & vbNewLine & _
"Warning!!! Running numbers on Read-only mode can cause report not total correctly", vbYesNo, "Already Opened") = vbNo Then Exit Sub
'Yes to open as read-only
Workbooks.Open FileName:=filePath & "\Appeals 01.xlsm"
Else
Workbooks.Open FileName:=filePath & "\Appeals 01.xlsm"
End If
'Save workbbook first if it is opened on this computer
Workbooks("Appeals 01.xlsm").Save
End If
'If Appeal 02.xlsm is not open on my computer
If Appeal02bool = False Then
'Then is it opened by others
If IsWorkBookOpen(filePath & "\Appeals 02.xlsm") Then
'If it is opened by others, do you want to open as Read-only?
If MsgBox("Appeal 02 is Opened. Do you want to open workbook as Read only?" & vbNewLine & vbNewLine & _
"Warning!!! Running numbers on Read-only mode can cause report not total correctly", vbYesNo, "Already Opened") = vbNo Then Exit Sub
'Yes to open as read-only
Workbooks.Open FileName:=filePath & "\Appeals 02.xlsm"
Else
Workbooks.Open FileName:=filePath & "\Appeals 02.xlsm"
End If
'Save workbbook first if it is opened on this computer
Workbooks("Appeals 02.xlsm").Save
End If
MsgBox ("Continue Code")
End Sub