VBA:Err.Clear,继续,恢复下一个不会阻止On Error GoTo仅执行一次

soc*_*pet 2 excel vba excel-vba

因此,在“发生错误时,GoTo执行一次”下出现了一些SO问题和Google结果,在几乎每种情况下,建议的解决方案都是添加Err.Clear或通过一些论坛Resume清除错误。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:
Run Code Online (Sandbox Code Playgroud)

Yow*_*E3K 5

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

如果检测到错误并On Error GoTo NoContact调用了您,则您的代码将跳至NoContact标签,然后最终仍在错误处理模式下找到回到For Each objFile In objFolder.Files循环起点的代码。

如果仍在错误处理模式下发生另一个错误,则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
Run Code Online (Sandbox Code Playgroud)

但是,正如蒂姆·威廉姆斯(Tim Williams)所评论的-最好避免出现需要On Error尽可能进行错误处理的情况。