如何循环发送电子邮件？答案

【问题标题】：How to send email in loop?如何循环发送电子邮件？
【发布时间】：2020-02-18 20:58:18
【问题描述】：

我正在尝试根据 Excel 中的单元格是否满足特定条件（在本例中为“是”）向选定的收件人发送电子邮件。

代码只会发送给它认为满足“是”条件的范围内的第一个用户。

Sub Read_Emails()

    ' SET Outlook APPLICATION OBJECT.

    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")

    ' CREATE EMAIL OBJECT.
    Dim objEmail As Object
    Set objEmail = objOutlook.CreateItem(olMailItem)

    For Each cell In Columns("N").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
          LCase(Cells(cell.Row, "R").Value) = "yes" Then

            With objEmail
                .To = cell.Value
                .CC = ""
                .Subject = "Subject here"
                .BodyFormat = olFormatHTML
                .HTMLBody = "Hello," & "<p>" & "Message here."
                .Send
            End With
        End If
    Next cell

    Set objEmail = Nothing
    Set objOutlook = Nothing

End Sub

【问题讨论】：

标签： excel vba outlook

【解决方案1】：

我自己使用https://www.rondebruin.nl/win/s1/outlook/bmail5.htm 解决了这个问题。

以下代码供对类似问题感兴趣的人使用：

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Columns("L").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" And _
       LCase(Cells(cell.Row, "P").Value) = "yes" Then

        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = cell.Value
            .Subject = "Subject here"
            .Body = "Hello " & Cells(cell.Row, "K").Value & "," _
              & vbNewLine & vbNewLine & _
                    "Message here."
            'You can add files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send  'Or use Display
        End With
        On Error GoTo 0
        Set OutMail = Nothing
    End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

【讨论】：