需要帮助在网络上打开另一个工作簿 [英] Need help on opening another workbook on the network

问题描述

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

我的问题是如果我有任何这些工作簿（B，C，D和E）在我的电脑上打开。代码将尝试重新打开这些工作簿，这将会触发一条消息：

B.xlsm已经打开，重新打开将导致您所做的任何更改丢弃，你想重新打开B.xlsm吗？

点击YES将关闭现有的工作簿（B）而不保存并重新打开它。
点击NO将弹出这个运行时错误'1004'：方法'打开对象工作簿'失败。

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

$ b $你可以让天才帮我弄清楚吗？

我的代码：

 函数IsWorkBookOpen（FileName As String）
 
 Dim ff As Long，ErrNo As Long 
 
 On Error Resume Next 
 ff = FreeFile （）
打开FileName输入锁读取为#ff 
关闭ff 
 ErrNo = Err 
出错GoTo 0 
 
选择案例ErrNo 
案例0：IsWorkBookOpen = False 
案例70：IsWorkBookOpen = True 
案例：错误ErrNo 
结束选择
 
结束函数
 
 Sub test2（）
 
 Dim FolderPath As String 
 Dim filePath As String 
 Dim wBook As String 
 FolderPa th = Application.ActiveWorkbook.Path 
 filePath = Left（FolderPath，InStrRev（FolderPath，\） -  1）
 wBook = filePath& \Appeals 01.xlsm
 
'如果工作簿被打开
如果IsWorkBookOpen（filePath&\Appeals 01.xlsm）然后
如果MsgBox（上诉01打开，要打开工作簿是否只读？& vbNewLine& vbNewLine& _ 
警告!!!在只读模式下运行的数字可能导致报告不能正确，vbYesNo， 已经打开）= vbNo然后退出Sub 
 Workbooks.Open FileName：= filePath& \Appeals 01.xlsm
 Else 
 Workbooks.Open FileName：= filePath& \Appeals 01.xlsm
 End If 
 MsgBox（Continue Code）
 
 End Sub 
  

希望你可以帮助我...谢谢你们：）

更新：感谢Tbizzness ，我修改了我的代码：

 函数IsWorkBookOpen（FileName As String）
 
 Dim ff As Long，ErrNo As Long 
 
 On Error Resume Next 
 ff = FreeFile（）
打开FileName输入锁定为#ff 
关闭ff 
 ErrNo = Err 
错误GoTo 0 
 
选择案例ErrNo 
案例0：IsWorkBookOpen = False 
案例70：IsWorkBookOpen = True 
 Case Else：错误ErrNo 
结束选择
 
结束函数
 
 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
 
'将Boolean设置为True，如果它在我的电脑上打开
对于每个WB1在Application.Workbooks 
如果WB1.Name =上诉01然后
 Appeal01bool = True 
 ElseIf WB1.Name =Appeals 02.xlsm然后
 Appeal02bool = True 
 End If 
 Next 
 
'如果上诉01.xlsm在我的电脑上没有打开
如果Appeal01bool = False然后
'然后是由别人打开
如果IsWorkBookOpen（filePath&\Appeals 01 .xlsm）然后
'如果它被别人打开，你想打开为只读？ 
如果MsgBox（Appeal 01 is Opened。要打开工作簿是否只读？& vbNewLine& vbNewLine& _ 
警告!!!在只读模式下运行数字可以导致报告不能正确，vbYesNo，已经打开）= vbNo然后退出Sub 
'是以只读方式打开
 Workbooks.Open FileName：= filePath& \Appeals 01.xlsm
 Else 
 Workbooks.Open FileName：= filePath& \Appeals 01.xlsm
 End If 
'如果在此计算机上打开，请先保存工作簿
工作簿（Appeals 01.xlsm）。Save 
 End If 
 
'如果Appeal 02.xlsm在我的电脑上没有打开
如果Appeal02bool = False然后
'然后被其他人打开
如果IsWorkBookOpen（filePath& \Appeals 02.xlsm）然后
'如果它被别人打开，你想打开为只读？ 
如果MsgBox（Appeal 02 is Opened。您要打开工作簿是否只读？& vbNewLine& vbNewLine& _ 
警告!!!在只读模式下运行数字可以导致报告不能正确，vbYesNo，已经打开）= vbNo然后退出Sub 
'是以只读方式打开
 Workbooks.Open FileName：= filePath& \Appeals 02.xlsm
 Else 
 Workbooks.Open FileName：= filePath& \Appeals 02.xlsm
 End If 
'如果在此计算机上打开，请先保存工作簿
工作簿（Appeals 02.xlsm）。Save 
 End If 
 
 MsgBox（继续代码）
 
 End Sub 
  

解决方案

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

  for application.workbooks 
如果wb.name = b然后
 bbool = True 
 elseif wb.name = c然后
 cbool = True 
 elseif wb.name = d然后
 dbool = True 
 elseif wb.name = e然后
 ebool = True 
如果
则为
 
如果bbool = false，那么application.workbooks.open（b）
如果cbool = false，那么application.workbooks.open c）
如果dbool = false then application.workbooks.open（d）
如果ebool = false t hen application.workbooks.open（e）
  

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

解决方案

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)

这篇关于需要帮助在网络上打开另一个工作簿的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！