vba - 向多个收件人发送电子邮件在错误处理程序上中断

Question

我正在尝试使用标准代码将工作簿通过电子邮件发送给多个收件人，但内置了一些可能在我的模型中出现的错误处理。

如果电子邮件地址不可用，则可找到电子邮件地址的单元格将显示“待搜索...”。

如果是这种情况，循环只需跳过该单元格并转到下一个电子邮件地址。

下面是我的代码。问题来自 IF/Then/Next 行。我收到一个没有 For 错误的 Next。任何投入将不胜感激。

Sub Mail_workbook_Outlook_1()


    Dim OutApp As Object
    Dim OutMail As Object
    Dim Position_In_Loop As Long
    Dim Total_Emails As Long
    Dim Email_Address As String
    Dim Dashboard As Worksheet
        Set Dashboard = ActiveWorkbook.Worksheets("Dashboard")
    Dim Body As Range
        Set Body = Dashboard.Range("F13")
    Dim Attachment As Range
        Set Attachment = Dashboard.Range("F24")


    With Dashboard
            Total_Emails = Dashboard.Range("G3")
    End With

    For Position_In_Loop = 1 To Total_Emails

        Email_Address = Dashboard.Range("C3").Offset(Position_In_Loop, 0)

        If Email_Address = "Pending Search..." Then Next Position_In_Loop

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

            On Error Resume Next
                With OutMail
                    .To = "Email_Address"
                    .CC = ""
                    .BCC = ""
                    .Subject = "Open Job Violations"
                    .Body = "Body"
                    .Attachments.Add (Attachment)
                    .Send
                End With
            On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing

    Next Position_In_Loop


End Sub

Answer 1

你不应该这样增加循环。您将跳过电子邮件。将整个 Outlook 邮件代码包含在 If 语句中。 选项显式

Sub Mail_workbook_Outlook_1()


    Dim OutApp As Object
    Dim OutMail As Object
    Dim Position_In_Loop As Long
    Dim Total_Emails As Long
    Dim Email_Address As String
    Dim Dashboard As Worksheet
    Set Dashboard = ActiveWorkbook.Worksheets("Dashboard")
    Dim Body As Range
    Set Body = Dashboard.Range("F13")
    Dim Attachment As Range
    Set Attachment = Dashboard.Range("F24")

    With Dashboard
        Total_Emails = Dashboard.Range("G3")
    End With

    For Position_In_Loop = 1 To Total_Emails

        Email_Address = Dashboard.Range("C3").Offset(Position_In_Loop, 0)

        If Email_Address <> "Pending Search..." Then

            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)

            On Error Resume Next
            With OutMail
                .To = "Email_Address"
                .CC = ""
                .BCC = ""
                .Subject = "Open Job Violations"
                .Body = "Body"
                .Attachments.Add Attachment
                .Send
            End With
            On Error GoTo 0

            Set OutMail = Nothing
            Set OutApp = Nothing
        End If
    Next Position_In_Loop


End Sub