在网络上打开另一个工作簿时需要帮助

Question

你能帮我解决这个问题吗？

我需要在工作簿 (A) 上运行一些代码来打开网络上的其他几个工作簿（B、C、D 和 E）。这些其他工作簿也不断被其他人使用。所以我打开这些其他工作簿没有问题...如果这些工作簿当前正在被其他人使用，它将以只读方式打开。

我的问题是我的计算机上是否打开了这些工作簿（B、C、D 和 E）中的任何一个。代码将尝试重新打开这些工作簿，这将触发一条消息：

“B.xlsm 已经打开。重新打开将导致您所做的任何更改都被丢弃。您要重新打开 B.xlsm 吗？”

单击“是”将关闭现有工作簿 (B) 而不保存并重新打开它。 点击NO会弹出这个运行时错误'1004": Method 'Open of object Workbooks' failed.

如何更改此代码，以便如果在我的计算机上打开工作簿（B、C、D 和 E）（由我打开而不是只读），它将继续执行代码而不重新打开它？

各位大神能帮我解决一下吗？？？

我的代码：

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

希望你能帮助我...谢谢你们:)

更新：感谢 Tbizzness，我已将代码修改为：

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

Answer 1

我会使用简单的 for 查找来检查打开的工作簿的所有标题，如果它是打开的，则将布尔值设置为 true，然后在打开任何工作簿之前检查布尔值：

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)