Question

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

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

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

＆＃34; B.xlsm已经开放。重新打开将导致您所做的任何更改被丢弃。你想重新开放B.xlsm吗？＆＃34;

单击“是”将关闭现有工作簿（B）而不保存并重新打开它。单击NO将弹出此运行时错误＆＃39; 1004＆＃34;：方法＆＃39;打开对象工作簿＆＃39;失败。

如何更改此代码，以便在我的计算机上打开工作簿（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

我会使用一个简单的外观来检查打开的工作簿的所有标题，如果它打开则将布尔值设置为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)

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

1 个答案: