检查文件是否打开以防止出现错误

Question

我已经查看过，并且找不到具体的答案。下面的代码提示用户是否打开特定的文件。如果用户点击否，则子结束。如果他们点击是，则子继续。我已经测试了这个文件打开，所有的作品很好。但后来我忘了打开该文件，并根据提示是点击并收到以下错误：

运行时错误“9”：

下标越界

对于此行的代码：

随着工作簿（“旋转 - 主日 - 12月2015.xlsm”）。表（“旋转”）

我明白为什么我得到的错误，但我该如何检查，如果“是”回答用户是真实的，以防止这个错误？

下面是完整的代码：

Sub Extract_Sort_1512_December() 
' 
' 
    Dim ANS As String 
    ANS = MsgBox("Is the December 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 
    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 <> "12" 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) = "12" 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 - December 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 

我在这段代码通过许多错误的工作在过去的两天，我有点炒，所以任何帮助表示赞赏。

这里是我的更新IF语句来检查，以进行所需的工作簿的状态：

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 
     ElseIf IsWBOpen("Swivel - Master - November 2015") Then 
    End If 

Answer 1

使用此功能检查，如果需要的工作簿打开：

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 

它看起来通过（已打开）工作簿的列表，并将该名称与它的参数进行比较。扩展名被剥离，没有路径前置，比较是不区分大小写的。
用法：
If IsWbOpen("Swivel - Master - December 2015") then '... proceed Else Exit Sub End If