如何编辑自动发送电子邮件的宏,以避免刷新电子邮件列表后多次发送电子邮件

时间:2018-12-14 00:17:43

标签: vba excel-2016

我创建了一个宏来自动将电子邮件发送给一群人。该过程将每天完成。但是,我不想向同一个人多次发送同一封电子邮件,而这可能每次都出现在我的列表中。有没有一种方法可以在Outlook中查看已发送邮件,从而避免多次发送电子邮件?下面是我的代码。非常感谢你!


Sub Mail_small_Text_Change_Account()

    Dim cel As Range
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")

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

    strbody = "Dear " & Cells(cell.Row, "C").Value _
                      & vbNewLine & vbNewLine & _
                        "Please contact us " & _
                        "to date"

    Set OutMail = OutApp.CreateItem(olMailItem)
    On Error Resume Next
        With OutMail
            .To = cell.Value
            '.CC = cel.Offset(0, 3).Value
            .Subject = "Subject"
            .Body = strbody
            .SendUsingAccount = OutApp.Session.Accounts.Item(2)
            .Display   'or use .Send
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell

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

0 个答案:

没有答案