0

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

Set xlContacts = Workbooks(LocalContactsFilename)

    它抛出一个错误，说下标超出范围，我知道这意味着在 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

提前感谢您对此的任何帮助！

4

2 回答 2

1

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

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

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

于 2013-01-25T01:48:12.223 回答
0

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

    Resume post_err
post_err:

 功能代码：

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

谢谢大家花时间看这个！

于 2013-01-25T16:32:05.833 回答