VBA:错误清除,恢复,恢复下一个不要阻止出错时GoTo只执行一次



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

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

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

最新更新