检查文件是否打开以防止错误 [英] Checking if File is open to prevent error

问题描述

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

I have looked and could not find an answer to this specifically. The below code prompts the user as to whether or not a specific file is open. If the user clicks no, the sub ends. If they click yes, the sub continues. I have tested this with the file open and all works great. But then I forgot to open the file and clicked yes when prompted and received the following error:

运行时错误"9":

下标超出范围

对于代码中的这一行:

带工作簿(旋转-大师-2015年12月.xlsm").表格(旋转")

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

我了解为什么会收到错误消息，但是如何检查用户的是"答案是否正确，以防止出现此错误消息?

I understand why I am getting the error, but how do I check if the "yes" answer from the user is true to prevent this error?

这是完整的代码:

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

在过去的两天里，我在这段代码中处理了很多错误，并且有点生气，所以我们将不胜感激.

I have worked through many errors in this code over the last two days and am a little fried, so any help is appreciated.

这是我更新的IF语句，用于检查继续进行所需的工作簿的状态:

Here is my updated IF statement to check the status of the workbook required to proceed:

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

推荐答案

使用此功能检查所需的工作簿是否已打开:

Use this function to check if the desired workbook is open:

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

It looks through the list of (opened) workbooks and compares the name to it's argument. The extension is stripped off, there is no path prepended and the comparison is case-insensitive.
Usage:
If IsWbOpen("Swivel - Master - December 2015") then '... proceed Else Exit Sub End If

这篇关于检查文件是否打开以防止错误的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！