檢查文件是否打開以防止出錯 - Pt。 2

Question

在參考此信息： Checking if File is open to prevent error 我已經更新了的代碼，但現在我接收：

運行時錯誤9： 標超出範圍

和調試器亮點這條線的代碼（全代碼如下，使用功能爲IsWBOpen一起）：

With Workbooks("Swivel - Master - November 2015.xlsm").Sheets("Swivel") 

我能想到的唯一的事情是，.Sheets（「旋轉」）是罪魁禍首，但我不知道的這個。

這裏就是我試圖完成：

如果用戶單擊否，則子與MSGBOX消息，說明該程序將終止結束。 如果用戶點擊yes和工作簿是不開放，因爲如果他們點擊無和子端用戶得到同樣的信息。 如果用戶單擊是並且工作簿已打開，則子繼續。

下面是函數：

Function IsWBOpen(WorkbookName As String) As Boolean 
' check if WorkbookName is already opened; WorkbookName is without path or extension! 
' comparison is case insensitive 
' 2015-12-30 

    Dim wb As Variant 
    Dim name As String, searchfor As String 
    Dim pos As Integer 

    searchfor = LCase(WorkbookName) 
    For Each wb In Workbooks 
     pos = InStrRev(wb.name, ".") 
     If pos = 0 Then       ' new wb, no extension 
      name = LCase(wb.name) 
     Else 
      name = LCase(Left(wb.name, pos - 1)) ' strip extension 
     End If 
     If name = searchfor Then 
      IsWBOpen = True 
      Exit Function 
     End If 
    Next wb 
    IsWBOpen = False 
End Function 

這裏主要分：

Sub Extract_Sort_1511_November() 
' 
' 
Dim ANS As String 

    ANS = MsgBox("Is the November 2015 Swivel Master File checked out of SharePoint and currently open on this desktop?", vbYesNo + vbQuestion + vbDefaultButton1, "Master File Open") 
    If ANS = vbNo Then 
     MsgBox "This procedure will now terminate.", vbOKOnly + vbExclamation, "Terminate Procedure" 
     Exit Sub 
    Else 
     If ANS = vbYes Then 
      If IsWBOpen("Swivel - Master - November 2015.xlsm") Then 
      End If 
      Else 
       MsgBox "This procedure will now terminate.", vbOKOnly + vbExclamation, "Terminate Procedure" 
       Exit Sub 
     End If 
    End If 

Application.ScreenUpdating = False 

    ' This line renames the worksheet to "Extract" 
    ' ActiveSheet.name = "Extract" 

    ' This line autofits the columns C, D, O, and P 
    Range("C:C,D:D,O:O,P:P").Columns.AutoFit 

    ' This unhides any hidden rows 
    Cells.EntireRow.Hidden = False 

Dim LR As Long 

    For LR = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1 
     If Range("B" & LR).Value <> "11" Then 
      Rows(LR).EntireRow.Delete 
     End If 
    Next LR 

With ActiveWorkbook.Worksheets("Extract").Sort 
    With .SortFields 
     .Clear 
     .Add Key:=Range("B2:B2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("D2:D2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("O2:O2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("J2:J2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("K2:K2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("L2:L2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
    End With 
    .SetRange Range("A2:Z2000") 
    .Apply 
End With 
Cells.WrapText = False 
Sheets("Extract").Range("A2").Select 

    Dim LastRow As Integer, i As Integer, erow As Integer 

    LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 
    For i = 2 To LastRow 
     If Cells(i, 2) = "11" Then 

      ' As opposed to selecting the cells, this will copy them directly 
      Range(Cells(i, 1), Cells(i, 26)).Copy 

      ' As opposed to "Activating" the workbook, and selecting the sheet, this will paste the cells directly 
      With Workbooks("Swivel - Master - November 2015.xlsm").Sheets("Swivel") 
       erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
       .Cells(erow, 1).PasteSpecial xlPasteAll 
      End With 
      Application.CutCopyMode = False 
     End If 
    Next i 

Application.ScreenUpdating = True 
End Sub 

FindWindow函數和user1016274一直在爭取代碼這一步非常有幫助。對此錯誤的所有幫助表示讚賞。

Answer 1

改變這一點：

Dim ANS As String 

    ANS = MsgBox("Is the November 2015 Swivel Master File checked out of SharePoint and currently open on this desktop?", vbYesNo + vbQuestion + vbDefaultButton1, "Master File Open") 
    If ANS = vbNo Then 
     MsgBox "This procedure will now terminate.", vbOKOnly + vbExclamation, "Terminate Procedure" 
     Exit Sub 
    Else 
     If ANS = vbYes Then 
      If IsWBOpen("Swivel - Master - November 2015.xlsm") Then 
      End If 
      Else 
       MsgBox "This procedure will now terminate.", vbOKOnly + vbExclamation, "Terminate Procedure" 
       Exit Sub 
     End If 
    End If 

到：

Dim ANS As Long 

ANS = MsgBox("Is the November 2015 Swivel Master File checked out of SharePoint and currently open on this desktop?", vbYesNo + vbQuestion + vbDefaultButton1, "Master File Open") 
If ANS = vbNo Or IsWBOpen("Swivel - Master - November 2015") = False Then 
    MsgBox "This procedure will now terminate.", vbOKOnly + vbExclamation, "Terminate Procedure" 
    Exit Sub     
End If