Question

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

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

我的问题是，如果有人可以请看看＆＃34; Next＆＃34;和＆＃34;退出子＆＃34;放置以便继续循环并生成＆＃34;错误弹出窗口＆＃34;连同电子邮件草稿＆＃34;没有停止代码。

提前致谢...

请找到以下代码......

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

尝试使用转到声明Please look into this link

Answer 2

我编辑了你的代码＆＃34;稍微＆＃34;，试一试：

修改我改变的是，我用过＆＃34;选择案例＆＃34;而不是多个＆＃34; Ifs＆＃34;，因为你有多个If选项。然后我添加了＃34; .Save＆＃34;和＆＃34;。关闭olpromptforsave＆＃34;保存并关闭消息窗口，以防它有附件或没有。 Goto很适合跳过代码，就像在这种情况下一样。

所以逻辑是：

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

如果您发现要附加的文件，请附加，保存，关闭，跳过错误消息并继续浏览另一个＆＃34; j＆＃34;

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

显示错误消息和恢复循环

2 个答案: