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

Question

我已经看过但找不到具体的答案。下面的代码提示用户是否打开了特定文件。如果用户单击否，则子结束。如果他们单击“是”，子程序将继续。我已经在打开文件的情况下对此进行了测试，一切正常。但是后来我忘记打开文件并在出现提示时单击是并收到以下错误：

运行-时间错误'9':

下标超出范围

对于代码中的这一行：

带工作簿("Swivel - Master - December 2015.xlsm").工作表("Swivel")

我明白为什么会收到错误，但我如何检查用户的 "yes" 回答是否正确以防止出现此错误？

完整代码如下：

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

它查看（打开的）工作簿列表并将名称与其参数进行比较。扩展名被剥离，没有前缀路径，比较是 case-insensitive.
用法：
If IsWbOpen("Swivel - Master - December 2015") then '... proceed Else Exit Sub End If

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

Checking if File is open to prevent error

excel

vba

excel-2007