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

这应该是直截了当的，但我不知怎么搞不好。我正在尝试从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

---

您在

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

---

为什么要重新发明轮子？将邮件合并到Word中的电子邮件。一切都准备好了，可以出发了。不需要代码。这只是一个更大项目的一小部分，该项目跟踪参与者在培训课程中的注册情况。现在所有的实现都在Excel中，我想不用离开程序就可以实现。另外，我不知道Word可以根据条件发送完全不同的电子邮件模板。在实际示例中，参与者有4种类型的挂起状态（pending1、pending2等）。基于此，我会发送不同类型的电子邮件。Pending1通知注册，pending2通知等待名单的参与者，pending3通知sombody状态更改为已注册，pending4通知状态更改为已取消。是的，Word可以做到这一点。合并字段可以处理条件逻辑。