Question

我使用以下代码循环遍历电子表格中的每一行。只要满足if条件，将自动发送提醒电子邮件。但通过这种方式，只会发送一封相同的电子邮件，其中所有电子邮件地址都显示在＆＃34; To：＆＃34;中。出于隐私目的，

我希望将电子邮件单独发送到不同的接收者（一次将电子邮件发送到一个接收者）。我应该如何更新循环来执行此操作？有什么想法吗？

Sub SendReminderMail()

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim iCounter As Integer
Dim MailDest As String
Dim NumRows As Integer

Set OutLookApp = CreateObject("Outlook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
NumRows = ActiveSheet.UsedRange.Rows.Count

With OutLookMailItem

MailDest = ""

For iCounter = 1 To NumRows

If MailDest = "" And Cells(iCounter, 6).Offset(0, -2) = "Send Reminder" Then
MailDest = Cells(iCounter, 6).Value
ElseIf MailDest <> "" And Cells(iCounter, 6).Offset(0, -2) = "Send Reminder" Then
MailDest = MailDest & ";" & Cells(iCounter, 6).Value
End If

Next iCounter

.To = MailDest
.CC = CC
.BCC = BCC
.Subject = "FYI"
.Body = "Reminder: Some Message"
.Send



End With

Set OutLookMailItem = Nothing
Set OutLookApp = Nothing

End Sub

Answer 1

您只需移动创建的代码部分并将电子邮件发送到循环中。

Sub SendReminderMail()

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim iCounter As Integer
Dim MailDest As String
Dim NumRows As Integer

Set OutLookApp = CreateObject("Outlook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
NumRows = ActiveSheet.UsedRange.Rows.Count

For iCounter = 1 To NumRows

    MailDest = ""

    If Cells(iCounter, 6).Offset(0, -2) = "Send Reminder" Then
        Set OutLookMailItem = OutLookApp.CreateItem(0)
        With OutLookMailItem

            MailDest = Cells(iCounter, 6).Value
            .To = MailDest
            .CC = CC
            .BCC = BCC
            .Subject = "FYI"
            .Body = "Reminder: Some Message"
            .Send
            Set OutLookMailItem = Nothing
        End With

    End If


Next iCounter

Set OutLookApp = Nothing

End Sub

使用VBA循环帐户并单独发送提醒电子邮件

1 个答案: