检查文件是否打开以防止错误 - Pt。 2

Question

参考这篇文章： Checking if File is open to prevent error 我已经更新了代码，但现在我收到了：

运行时错误 9： 下标超出范围

调试器会突出显示这行代码（完整代码如下，以及 IsWBOpen 的函数）：

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

我唯一能想到的是 .Sheets("Swivel") 是罪魁祸首，但我不确定。

这是我想要完成的：

如果用户单击否，则 sub 以 MsgBox 消息结束，说明此过程将终止。 如果用户单击“是”并且工作簿未打开，则用户会收到与单击“否”相同的消息并且子结束。 如果用户单击 Yes 并且工作簿已打开，则 sub 继续。

这里是函数：

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