首页 文章

VBA:Err.Clear,Resume,Resume Next不会阻止On Error GoTo仅执行一次

提问于
浏览
2

所以有几个SO问题和谷歌搜索结果出现在"On Error GoTo executes once"之下,几乎在每种情况下推荐的解决方案都是添加 Err.ClearResume 的某个论坛以清除错误 . VBA错误一次只能处理一个,因此需要清除它们 .

实现这些之后,正如您可能已经猜到的那样,我遇到了这个问题,其中 On Error GoTo 只执行一次,我无法弄清楚原因 .

下面是我的循环 . 我确实将一些代码留在了顶部,因为它有相当多的代码并且没有相关性 . 主要是用户提示和制作数组 . 为了解释一下发生了什么, conos() 是一个包含特定列值的数组 . 基于文件名的一部分,它搜索数组中的代码,以获得与该行对应的索引 .

如果没有 Match 则会触发错误 . 这只是意味着有一个文件,但没有联系人发送它 . 它应该跳到 NoContact 并创建这些文件的列表 .

因此,对于我的文件,第一个有联系人并生成电子邮件,第二个没有并跳到 NoContact 并将文件添加到列表中 . 还有五个与联系人一起运行,然后它会转到另一个应该转到 NoContact ,但 Unable to get the Match property of the WorksheetFunction class 出现了 .

似乎错误没有从第一个清除 . 不知道为什么 .

For Each objFile In objFolder.Files

    wbName = objFile.Name

    ' Get the cono along with handling for different extensions
    wbName = Replace(wbName, ".xlsx", "")
    wbName = Replace(wbName, ".xlsm", "")
    wbName = Replace(wbName, ".xls", "")

    ' Split to get just the cono
    fileName() = Split(wbName, "_")
    cono = fileName(2)

    ' Create the cell look up
    c = Cells(1, WorksheetFunction.Match("Cono", cols(), 0)).Column

    ' ******************** ISSUE IS HERE ***************************
    On Error GoTo NoContact
    r = Cells(WorksheetFunction.Match(cono, conos(), 0), c).Row
    Cells(r, c).Select

    ' Fill the variables
    email = Cells(r, c).Offset(0, 1).Value
    firstName = Cells(r, c).Offset(0, 3).Value
    lastName = Cells(r, c).Offset(0, 4).Value
    account = Cells(r, c).Offset(0, -2).Value
    username = Cells(r, c).Offset(0, 6).Value
    password = Cells(r, c).Offset(0, 7).Value
    fPassword = Cells(r, c).Offset(0, 8).Value

    ' Mark as completed
    Cells(r, c).Offset(0, 9).Value = "X"

    ' Set the object variables
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    ' Body of the email
    str = "Hi " & firstName & "," & vbNewLine & vbNewLine & _
          "This is line 1" & vbNewLine & _
          "This is line 2" & vbNewLine & _
          "This is line 3" & vbNewLine & _
          "This is line 4"

    ' Parameters of the email
    On Error Resume Next
    With OutMail
        .To = email
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = str
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
    End With
    On Error GoTo 0

    ' Based on the user prompts, whether or not the emails will be sent without checking them first
    If finalCheck = vbYes Then
        OutMail.Send
    Else
        OutMail.Display
    End If

NoContact:

    ' Determiine which files don't have a corresponding email and add to list
    If email = Empty Then
        If conoB <> "" Then
            conoB = conoB & ", " & cono
        Else
            conoB = cono
        End If
    End If

    Err.Clear

    ' Clear variables for next use
    Set OutMail = Nothing
    Set OutApp = Nothing
    cono = Empty
    email = Empty
    firstName = Empty
    lastName = Empty
    account = Empty
    username = Empty
    password = Empty
    fPassword = Empty

Next:

1 回答

  • 4

    Err.Clear 只是清除 Err 对象中有关上一个错误的信息 - 它不会退出错误处理模式 .

    如果检测到错误并且调用了 On Error GoTo NoContact ,则代码会跳转到 NoContact 标签,然后最终找到回到 For Each objFile In objFolder.Files 循环 while still in error-handling mode 的开头 .

    如果在仍处于错误处理模式时发生另一个错误,VBA将抛出错误,因为它无法再捕获它 .

    您应该按照以下方式构建代码

    For Each objFile In objFolder.Files
            '...
            On Error GoTo NoContactError
            '...
    NoContact:
            '...
        Next
        '...
        Exit Sub
    
    NoContactError:
        'Error handling goes here if you want it
        Resume NoContact
    End Sub
    

    但是,正如蒂姆·威廉姆斯所评论的那样 - 尽可能避免需要 On Error 错误处理的情况要好得多 .

相关问题