Excel VBA для отправки писем разным людям в столбце

Question

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

Обычно это выглядит так:

Что бы я хотелслучается, что электронное письмо должно быть сгенерировано для каждого упомянутого администратора.Пока у меня есть следующее (адреса электронной почты моей компании настроены как «first.last@email.email»):

Sub Email_Test()

Columns("F:F").Select
Selection.Replace What:=" ", Replacement:=".", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.Display
End With
    signature = OMail.body
With OutMail
    .To = Range("F2") & "@email.email" & "; " & Range("F3") & "@email.email" & "; " & Range("F4") & "@email.email" & "; " & Range("F5") & "@email.email" & "; " & Range("F6") & "@email.email"
    .CC = ""
    .BCC = ""
    .Subject = "Report"
    .HTMLBody = "See attached" & "<br>" & .HTMLBody
    .Attachments.Add ActiveWorkbook.FullName
    .DeferredDeliveryTime = ""
    .Display
End With
On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Очевидно, что это не сработает, но, надеюсь, это иллюстрирует мою идею.Есть ли способ для меня, чтобы найти столбец F для каждого уникального экземпляра имени, а затем добавить расширение электронной почты?Я уверен, что есть менее запутанный способ, чем у меня сейчас.

Спасибо!

Answer 1

Итак, во-первых, очень опасно угадывать адреса электронной почты из списка имен. (Вы уверены, что нет двух Пол Блартс? Если это так, то только один получает отчет. Вы уверены, что нет двух пижам Тони? Если так, то правильный ли получить отчет?) В любом случае, я предполагаю, что вы все это обдумали, и вы сможете сохранить свою работу, если она пойдет не к той пижаме.

Я бы использовал scripting.dictionary для хранения электронных писем, используя имена или адреса электронной почты в качестве ключа. Затем я могу проверить членство в dict, прежде чем добавить еще один:

Не проверено, но должно дать вам ответ:

Public Sub CreateEmails()
    Dim row As Long
    Dim email_address As String
    Dim email_dict As Object
    Set email_dict = CreateObject("Scripting.Dictionary")

    Set OutApp = CreateObject("Outlook.Application")
    Dim OutMail As Object

    row = 2
    Do While ThisWorkbook.Sheets("SheetWithNames").Cells(row, 6).Value <> ""
        email_address = email_address_from_name(.Cells(row, 6).Value) 'turns a name into an email
        If Not email_dict.exists(email_address) Then
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = email_address
                .Subject = "Report"
                .HTMLBody = "See attached" & "<br>" & .HTMLBody
                .Attachments.Add ActiveWorkbook.FullName
                .Display
            End With
            email_dict.Add email_address, OutMail
        End If
        row = row + 1
    Loop
End Sub