使用宏向特定收件人发送电子邮件

Question

我正在尝试向特定收件人发送电子邮件提醒，并将其关联的用户 ID 存储在 Excel 工作表中。如果收件人没有完成调查，电子邮件只会发送给他们。 (细胞(iCounter,3))

MailDest 是所有收件人电子邮件所在的位置。 DGName 包含收件人的所有关联用户 ID。一位收件人可以拥有多个用户 ID。

问题是收件人的所有用户 ID (DGName) 都是在发送给他们的每封电子邮件中生成的。

我应该如何编辑我的代码，以便它将电子邮件发送给收件人相关的电子邮件及其用户 ID？

编辑 以下是代码：

Sub SendReminderMail()

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

Set OutLookApp = CreateObject("Outlook.application")    
Set OutLookMailItem = OutLookApp.CreateItem(0)

With OutLookMailItem    
    MailDest = ""    
    For iCounter = 1 To WorksheetFunction.CountA(Columns(5))

        If MailDest = "" And Cells(iCounter, 3) = "" Then
            MailDest = Cells(iCounter, 5).Value
            DGName = Cells(iCounter, 1).Value
        ElseIf MailDest <> "" And Cells(iCounter, 3) = "" Then
            MailDest = MailDest & ";" & Cells(iCounter, 5)
            DGName = DGName & ";" & Cells(iCounter, 1)
        End If

    Next iCounter

    .BCC = MailDest
    .Subject = "W2K16 update on Cloudworkplace Desktop Group"
    .HTMLBody = "Dear ~Whoever ," & "<br/><br/>" & DGName & "<br/><br/>" & " ~Message"
    .send

在此示例中，如果“反馈”列为空，则会触发宏向收件人发送提醒邮件。

Sample Excel Data

Answer 1

好吧，目前您将 1 封电子邮件发送到多个地址 (BCC)。因此，您需要更改代码以发送多个单独的邮件（每个地址 1 封邮件）。

因此只需将发送邮件的代码放在 for 循环中：

With OutLookMailItem       
    For iCounter = 1 To WorksheetFunction.CountA(Columns(16))
        If Cells(iCounter, 14) = "" Then
            MailDest = Cells(iCounter, 16).Value
            DGName = Cells(iCounter, 12).Value
            .To = MailDest
            .Subject = "W2K16 update on Cloudworkplace Desktop Group"
            .HTMLBody = "Dear ~Whoever ," & "<br/><br/>" & DGName & "<br/><br/>" & " ~Message"
            .send
        End If
    Next iCounter

Answer 2

当我查看您的代码时发现 DGName 变量在再次循环到 For 1st 循环后需要生成空白字符串

我在解决方案中写这个，因为无法写评论。 代码如下所示

Sub SendReminderMail()

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

Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)

With OutLookMailItem
    MailDest = ""

    For iCounter = 1 To WorksheetFunction.CountA(Columns(16))
    DGName = "" 'see here

        If MailDest = "" And Cells(iCounter, 14) = "" Then
            MailDest = Cells(iCounter, 16).Value
            DGName = Cells(iCounter, 12).Value
        ElseIf MailDest <> "" And Cells(iCounter, 14) = "" Then
            MailDest = MailDest & ";" & Cells(iCounter, 16)
            DGName = DGName & ";" & Cells(iCounter, 12)
        End If

    Next iCounter

    .BCC = MailDest
    .Subject = "W2K16 update on Cloudworkplace Desktop Group"
    .HTMLBody = "Dear ~Whoever ," & "<br/><br/>" & DGName & "<br/><br/>" & " ~Message"
    .send