Использование макросов для отправки электронной почты конкретным получателям

Question

Я пытаюсь отправить напоминание по электронной почте конкретному получателю с указанием связанных с ним идентификаторов пользователей, хранящихся в листе Excel. Письмо будет отправлено только получателю, если он не завершил опрос. (Клетки (iCounter, 3)) * * +1001

MailDest - это адрес электронной почты всех получателей. DGName содержит все связанные идентификаторы пользователя получателя. Один получатель может иметь более одного идентификатора пользователя.

Проблема в том, что все идентификаторы пользователей (DGName) получателей генерируются в каждом отправляемом им электронном письме.

Как мне отредактировать свои коды, чтобы они отправляли электронную почту получателям, связанным с электронной почтой, и их идентификаторам пользователей?

EDIT Вот коды:

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

В этом примере, если столбец «Обратная связь» пуст, макрос запускает отправку напоминания по электронной почте получателю.

Образец данных Excel

Answer 1

Когда я проверял ваш код, выяснилось, что переменная DGName должна сделать пустую строку после повторного цикла в For 1st loop

Я пишу это в решении, потому что не могу написать комментарий. код что-то вроде ниже

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

Answer 2

Ну, на данный момент вы отправляете 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