1

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
pnuts
  • 58,317
  • 11
  • 87
  • 139
Tom
  • 13
  • 4

1 Answers1

0

I would use a simple for look to check all the titles of the open workbooks and set a boolean to true if it is open, then check the boolean before opening any workbooks:

for each wb in application.workbooks
   if wb.name = b then
       bbool = True
   elseif wb.name = c then
       cbool =  True
   elseif wb.name = d then
       dbool = True
   elseif wb.name = e then
       ebool = True
   end if
Next

if bbool = false then application.workbooks.open(b)
if cbool = false then application.workbooks.open(c)
if dbool = false then application.workbooks.open(d)
if ebool = false then application.workbooks.open(e)
Tbaker
  • 197
  • 1
  • 1
  • 10
  • That works perfect for me. Thank you Tbizzness. I'm a beginner at VBA, and I just learned boolean today. Thank you. :) – Tom Nov 06 '14 at 23:08