Excel VBA On Error Resume Next，选项正确但仍未恢复

Excel VBA On Error Resume Next, Options are correct but still not resuming

提问by Ross McConeghy

    I have already checked Tools > Options > General > Error Trapping in VBE - I have set it to both "Break in Class Module" and "Break on Unhandled Errors" and either way it still throws the error. The error is thrown on the line:

    我已经在 VBE 中检查了工具 > 选项 > 常规 > 错误捕获 - 我已将其设置为“中断类模块”和“中断未处理的错误”，无论哪种方式它仍然会引发错误。错误就抛出了：

Set xlContacts = Workbooks(LocalContactsFilename)

    It throws an error saying the subscript is out of range, and I understand that this means the index was not found within the Workbooks collection, this statement is here because usually the file is already open as an addin so I can just get a reference to it through this statement. It is supposed to resume on this error because if the file is not open I open it.

    One odd thing I noticed about this- even though this line of code is not accessing any remote files or the network, it only throws this error when I am disconnected from the network. If I open the workbook while connected to the network this error is not thrown.

    Has anyone experienced this before? When your options are set to only halt on unhandled exceptions but it halts anyways?

    它抛出一个错误，说下标超出范围，我知道这意味着在 Workbooks 集合中找不到索引，这个语句在这里是因为通常文件已经作为插件打开，所以我可以得到一个引用它通过这个声明。它应该在出现此错误时恢复，因为如果文件未打开，我将打开它。

    我注意到了一件奇怪的事情——即使这行代码没有访问任何远程文件或网络，它只会在我与网络断开连接时抛出这个错误。如果我在连接到网络时打开工作簿，则不会引发此错误。

    有谁之前经历过这个吗？当您的选项设置为仅在未处理的异常时停止，但它无论如何都会停止？

Public Sub openContactsFile()
    On Error Resume Next
    Dim fso As New FileSystemObject
    Dim LocalContactsPath As String
    Dim LocalContactsFilename As String
    Dim LocalContactsShortFilename As String

    LocalContactsPath = wbMyCompanyWorkbook.Names("localContactsPath").RefersToRange.Value
    LocalContactsFilename = Mid(LocalContactsPath, (InStrRev(LocalContactsPath, "\") + 1))
    LocalContactsShortFilename = Mid(LocalContactsFilename, 1, (InStrRev(LocalContactsFilename, ".") - 1))

    'On Error Resume Next
    Application.ScreenUpdating = False

    If Not fso.FileExists(LocalContactsPath) Then
        If MsgBox("The contacts file is not available.  Click Yes to update the contacts now, or No to use the workbook without contact auto-fill capability.", vbYesNo, ThisWorkbook.NAME) = vbYes Then
            SyncContacts
        Else
            GoTo cancelParse
        End If
    End If
    If fso.FileExists(LocalContactsPath) Then
        On Error GoTo catch_no_remote_connection
        If fso.GetFile(LocalContactsPath).DateLastModified < fso.GetFile(wbMyCompanyWorkbook.Names("remoteContactsPath").RefersToRange.Value).DateLastModified Then
            If MsgBox("Your local contacts file appears to be out of date, would you like to download the latest contacts file?", vbYesNo Or vbQuestion, ThisWorkbook.NAME) = vbYes Then
                SyncContacts
            End If
        End If
catch_no_remote_connection:
        If Err.Number = 53 Then Err.CLEAR
        On Error Resume Next
        Set xlContacts = Workbooks(LocalContactsFilename)

        If xlContacts Is Nothing Then
            Set xlContacts = Workbooks.Open(LocalContactsPath, False, True)
        End If
        xlContacts.Sheets(1).Range("A1:CN2000").Sort Key1:=xlContacts.Sheets(1).Range("F2"), Order1:=xlAscending, Key2:=xlContacts.Sheets(1).Range("B2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    End If

    'hide the contacts from view or editing
    On Error Resume Next
    If Not Workbooks(LocalContactsFilename) Is Nothing Then xlContacts.IsAddin = True
    Err.CLEAR
    On Error GoTo 0
cancelParse:
    Application.ScreenUpdating = True
    Exit Sub
End Sub

Thanks in advance for any help with this!

在此先感谢您的帮助！

回答by mkingston

I have had the same (unbelievably frustrating, as far as I can tell inexplicable) problem as you have, but in a different context. I find the best thing to do is to find a work-around. Instead of using error handling as you have, use this instead:

我和你有同样的（令人难以置信的令人沮丧，据我所知是莫名其妙的）问题，但在不同的背景下。我发现最好的办法是找到一个变通办法。不要像你那样使用错误处理，而是使用这个：

Dim wb As Workbook, _
    xlContacts As Workbook

For Each wb In Application.Workbooks
    If wb.Name = LocalContactsFilename Then
        Set xlContacts = wb
        Exit For
    End If
Next wb

If xlContacts Is Nothing Then
    Set xlContacts = Workbooks.Open(LocalContactsPath, False, True
End If

I would've preferred to code it the way you've done, but it seems there's no choice.

我更愿意按照您的方式对其进行编码，但似乎别无选择。

回答by Ross McConeghy

@TimWilliams
    Thank you for the answer- I assumed Err.CLEAR resets the error handling but it does not. The code below functions correctly whether connected to the network or not (which I realize now was the origin of the problem), the problem was when it threw the file not found error and went to catch_no_remote_connection, there was no resume to clear the error, so I added this to close out the error handling block and reset the handler:

@TimWilliams
    谢谢你的回答 - 我假设 Err.CLEAR 重置了错误处理，但它没有。无论是否连接到网络，下面的代码都能正常运行（我现在意识到这是问题的根源），问题是当它抛出文件未找到错误并转到 catch_no_remote_connection 时，没有恢复清除错误，所以我添加了这个来关闭错误处理块并重置处理程序：

    Resume post_err
post_err:

 Functional Code:

 功能代码：

Public Sub openContactsFile()
    On Error Resume Next
    Dim fso As New FileSystemObject
    Dim LocalContactsPath As String
    Dim LocalContactsFilename As String
    Dim LocalContactsShortFilename As String

    LocalContactsPath = wbMyCompanyWorkbook.Names("localContactsPath").RefersToRange.Value
    LocalContactsFilename = Mid(LocalContactsPath, (InStrRev(LocalContactsPath, "\") + 1))
    LocalContactsShortFilename = Mid(LocalContactsFilename, 1, (InStrRev(LocalContactsFilename, ".") - 1))

    Application.ScreenUpdating = False

    If Not fso.FileExists(LocalContactsPath) Then
        If MsgBox("The contacts file is not available.  Click Yes to update the contacts now, or No to use the workbook without contact auto-fill capability.", vbYesNo, ThisWorkbook.NAME) = vbYes Then
            SyncContacts
        Else
            GoTo cancelParse
        End If
    End If
    If fso.FileExists(LocalContactsPath) Then
        On Error GoTo catch_no_remote_connection
        If fso.GetFile(LocalContactsPath).DateLastModified < fso.GetFile(wbMyCompanyWorkbook.Names("remoteContactsPath").RefersToRange.Value).DateLastModified Then
            If MsgBox("Your local contacts file appears to be out of date, would you like to download the latest contacts file?", vbYesNo Or vbQuestion, ThisWorkbook.NAME) = vbYes Then
                SyncContacts
            End If
        End If
catch_no_remote_connection:
        'there is no network connection, clear the error and resume from here
        Err.CLEAR
        Resume post_err
post_err:
        On Error Resume Next
        'get reference to the workbook if it is already open
        Set xlContacts = Workbooks(LocalContactsFilename)

        If xlContacts Is Nothing Then
            'the workbook was not open, open it
            Set xlContacts = Workbooks.Open(LocalContactsPath, False, True)
        End If
        'sort contacts by company, name
        xlContacts.Sheets(1).Range("A1:CN2000").Sort Key1:=xlContacts.Sheets(1).Range("F2"), Order1:=xlAscending, Key2:=xlContacts.Sheets(1).Range("B2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    End If

    'hide the contacts from view or editing by setting the workbook as an Addin
    On Error Resume Next
    If Not Workbooks(LocalContactsFilename) Is Nothing Then xlContacts.IsAddin = True
    Err.CLEAR
    On Error GoTo 0
cancelParse:
    Application.ScreenUpdating = True
    Exit Sub
End Sub

Thank you all for taking the time to look at this!

感谢大家花时间看这个！