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

时间:2017-03-03 06:38:04

标签: excel vba excel-vba

所以有几个SO问题和Google结果出现在" On Error GoTo执行一次"几乎在每种情况下,建议的解决方案是添加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 个答案:

答案 0 :(得分:4)

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

如果检测到错误并且您的On Error GoTo NoContact被调用,则代码会跳至NoContact标签,然后最终找到回到For Each objFile In objFolder.Files循环的开头< strong>仍处于错误处理模式。

如果在仍处于错误处理模式时发生另一个错误,则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错误处理的情况要好得多。