Question

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

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

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

以下是我的代码。问题来自IF / Then / Next行。我得到一个没有错误的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

Answer 2

更改此行 If Email_Address = "Pending Search..." Then Next Position_In_Loop 到

If Email_Address = "Pending Search..." Then 
 Position_In_Loop=Position_In_Loop+1
end if

电子邮件到多个收件人中断错误处理程序

2 个答案: