Question

这应该很简单，但是我不知道怎么做。我正在尝试从Excel设置自动发送电子邮件。我已经按照步骤从其他帖子的步骤，但没有成功。为了简单起见，这是我创建的一个虚拟示例。

我想：

向列表中的所有人发送电子邮件
有条件地替换正文中的某些关键字
用每封电子邮件的发送状态填充一列（发送/失败）

我当前的代码仅将电子邮件发送给列表中的第一个人。我已使用我的个人电子邮件地址进行测试。我不知道是否将电子邮件发送到相同的地址。如果有人可以提供一些指导，将不胜感激！

Sub SendMail()

Dim EmailSent, EmailFailed, i As Integer
Dim StatusSent, StatusFailed As String

Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")

Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)


EmailSent = 0
EmailFailed = 0
StatusFailed = "failed"
StatusSent = "sent"
i = 1

Do
DoEvents

    With olMail
        .To = Cells(i, 1).Value
        .Subject = "test"
        .CC = ""
        .BCC = ""
        .Importance = olImportanceHigh
        .BodyFormat = olFormatHTML

        .HTMLBody = Cells(i, 2).Value

        If Cells(i, 3) = 1 Then
            .HTMLBody = VBA.Replace(olMail.HTMLBody, "replace_me", Cells(i, 4))
        Else
            .HTMLBody = VBA.Replace(olMail.HTMLBody, "replace_me", Cells(i, 5))
        End If

       .send

    End With

    On Error Resume Next
    olMail.send

    If Err Then
        EmailFailed = EmailFailed + 1
        ActiveSheet.Cells(i, 6).Value = StatusFailed    'change status from pending to failed
    Else
        EmailSent = EmailSent + 1
        ActiveSheet.Cells(i, 6).Value = StatusSent  'change status from pending to sent
    End If

    i = i + 1
Loop Until i = Range(Range("A1"), Range("A1").End(xlDown)).Count

If EmailSent = 0 Then
    MsgBox Prompt:="Emails could not be sent"
Else
    MsgBox Prompt:="Sent emails: " & EmailSent & vbNewLine _
    & "Failed emails: " & EmailFailed
End If

On Error GoTo 0
Set olApp = Nothing
Set olMail = Nothing

End Sub

Answer 1

您在Do循环中缺少两条关键线：

Set olMail = olApp.CreateItem(olMailItem)

最后：

Set olMail = Nothing

尝试以下方法：

Sub SendMail()

    Dim EmailSent, EmailFailed, i As Integer
    Dim StatusSent, StatusFailed As String

    Dim olApp As Outlook.Application
    Set olApp = CreateObject("Outlook.Application")

    Dim olMail As Outlook.MailItem

    EmailSent = 0
    EmailFailed = 0
    StatusFailed = "failed"
    StatusSent = "sent"
    i = 1

    Do
    DoEvents
        Set olMail = olApp.CreateItem(olMailItem)

        With olMail
            .To = Cells(i, 1).Value
            .Subject = "test"
            .CC = ""
            .BCC = ""
            .Importance = olImportanceHigh
            .BodyFormat = olFormatHTML

            .HTMLBody = Cells(i, 2).Value

            If Cells(i, 3) = 1 Then
                .HTMLBody = VBA.Replace(olMail.HTMLBody, "replace_me", Cells(i, 4))
            Else
                .HTMLBody = VBA.Replace(olMail.HTMLBody, "replace_me", Cells(i, 5))
            End If

           .send

        End With

        On Error Resume Next
        olMail.send

        If Err Then
            EmailFailed = EmailFailed + 1
            ActiveSheet.Cells(i, 6).Value = StatusFailed    'change status from pending to failed
        Else
            EmailSent = EmailSent + 1
            ActiveSheet.Cells(i, 6).Value = StatusSent  'change status from pending to sent
        End If

        Set olMail = Nothing

        i = i + 1
    Loop Until i = Range(Range("A1"), Range("A1").End(xlDown)).Count

    If EmailSent = 0 Then
        MsgBox Prompt:="Emails could not be sent"
    Else
        MsgBox Prompt:="Sent emails: " & EmailSent & vbNewLine _
        & "Failed emails: " & EmailFailed
    End If

    On Error GoTo 0
    Set olApp = Nothing

End Sub

从Excel设置批量分发电子邮件列表

1 个答案: