显示错误信息并恢复循环

Question

我创建了一个 VBA 宏代码来使用各种标准生成具有不同收件人、主题、邮件内容、附件等的电子邮件...

代码运行良好，但附件出现问题时除外。当宏无法在给定位置找到相关文件时，它会弹出一条消息，但不会进一步推进循环。

我的问题是，如果有人可以请看看“下一步”和“退出子”应该放在哪里，以便在不停止代码的情况下继续循环并生成“错误弹出窗口”以及“电子邮件草稿”。

提前谢谢...

请在下面找到代码...

Sub Email_Creation_Tool()
    On Error GoTo ErrMsg
    Dim wbk As Workbook
    Dim OutApp As Object
    Dim OutMail As Object, signature As String
    Dim i As Range, j As Long
    Dim objItem As Object

    With ActiveSheet
        Set i = Range("A2", Range("A2").End(xlDown))
        For j = 1 To i.Rows.Count
            Set OutApp = CreateObject("Outlook.Application")
            If Cells(j + 1, 1).Value <> "" Then
                Mailto = Cells(j + 1, 3).Value

                If Mailto = "Sentence No. 1" Then
                    Mailto = "Friend1@abc.com"
                    MailSubject = Cells(j + 1, 1).Value & " Sentence No. 1"
                    MailBody = " Hi blah blah "
                End If

                If Mailto = "Sentence No. 2” Then
                    Mailto = "Friend2@abc.com; Friend3@abc.com"
                    CCTo = "CommonFriend@abc.com"
                    MailSubject = Cells(j + 1, 1).Value & " Sentence No. 2"
                    MailBody = "Hi blah blah,"
                End If

                If Mailto = "Sentence No. 2” Then
                    MailSubject =  Cells(j + 1, 1).Value & " Sentence No. 3"
                    Mailto = "Friend2@abc.com; Friend3@abc.com"
                    CCTo = "CommonFriend@abc.com"
                    MailBody = " Hi blah blah "      
                End If

                Set OutApp = CreateObject("Outlook.Application")
                Set OutMail = OutApp.CreateItem(o)
                With OutMail
                    .Display
                    signature = OutMail.body

                    With OutMail
                        .Subject = MailSubject
                        .To = Mailto
                        .CC = CCTo
                        .body = MailBody & vbNewLine & signature


                        Name "D:\Users\MY_PC\Desktop\" & Cells(j + 1, 1).Value & ".txt" As "D:\Users\MY_PC\Desktop\" & Cells(j + 1, 1).Value & "_trial.txt"
                        Attach = "D:\Users\MY_PC\Desktop\" & Cells(j + 1, 1).Value & "_trial.txt"
                        .Attachments.Add (Attach)

                        Exit Sub 'where should this be placed
                        On Error Resume Next  'where should this be placed

                    End With
                    Set OutMail = Nothing
                    Set OutApp = Nothing
                End With
            End If

            On Error Resume Next 'where should this be placed

            ErrMsg:

            MsgBox ("Attachment WP" & (Cells(j + 1, 1).Value) & vbNewLine & _
            "Not Found/Name Incorrect")
        Next j
    End With
End Sub

Answer 1

尝试使用 Go to 语句Please look into this link

Answer 2

我“稍微”编辑了您的代码，试一试：

编辑 我改变的是，我使用“Select case”而不是多个“Ifs”，因为您有多个 If 选项。然后我添加了“.Save”和“.Close olpromptforsave”来保存和关闭消息窗口，以防它有附件或没有附件。 Goto 非常适合跳转代码，就像本例一样。

所以逻辑是：

如果您没有找到要附加的文件，请跳至错误消息，然后继续执行 nextJ 代码：保存并关闭，继续执行另一个“j”（无论是否找到文件，nextJ 代码都会运行）

如果您找到要附加的文件，请附加、保存、关闭、跳过错误消息并继续到另一个“j”

Sub Email_Creation_Tool()
Dim wbk As Workbook
Dim OutApp As Object, OutMail As Object, objItem As Object
Dim i As Integer, j As Long, signature As String

For j = 2 To Range("A" & Rows.Count).End(xlUp).Row
  If Cells(j + 1, 1).Value <> vbNullString Then
Mailto = Cells(j + 1, 3).Value

select case Mailto
    case "Sentence No. 1"
        Mailto = "Friend1@abc.com"
        MailSubject = Cells(j + 1, 1).Value & " Sentence No. 1"
        MailBody = " Hi blah blah "
    case "Sentence No. 2"
        Mailto = "Friend2@abc.com; Friend3@abc.com"
        CCTo = "CommonFriend@abc.com"
        MailSubject = Cells(j + 1, 1).Value & " Sentence No. 2"
        MailBody = "Hi blah blah,"
    case "Sentence No. 3"
        MailSubject =  Cells(j + 1, 1).Value & " Sentence No. 3"
        Mailto = "Friend2@abc.com; Friend3@abc.com"
        CCTo = "CommonFriend@abc.com"
        MailBody = " Hi blah blah "
End Select

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
    .Display
    signature = OutMail.body
    .Subject = MailSubject
    .To = Mailto
    .CC = CCTo
    .body = MailBody & vbNewLine & signature
    Attach = "D:\Users\MY_PC\Desktop\" & Cells(j + 1, 1).Value & "_trial.txt"
    If Dir(Attach) = vbNullString then GoTo ErrMsg
    .Attachments.Add (Attach)
    GoTo nextJ
ErrMsg:
MsgBox ("Attachment WP " & (Cells(j + 1, 1).Value) & vbNewLine & "Not Found/Name Incorrect")
nextJ:
.Save
.Close olpromptforsave
End With
End If
Next j

Set OutMail = Nothing
Set OutApp = Nothing
End Sub