excel - 显示错误消息并恢复循环

Question

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

该代码可以正常工作，除非附件存在问题。当宏无法在给定位置找到相关文件时，它会 pop 消息，但循环不会继续进行。

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

提前致谢...

请在下面找到代码...

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

我“稍微”编辑了您的代码，尝试一下:

编辑
我更改的是，我使用“选择大小写”而不是多个“If”，因为您有多个“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