Блог

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

Обычно это выглядит следующим образом:

Чего бы я хотел, так это чтобы каждому упомянутому администратору было сгенерировано электронное письмо. На данный момент у меня есть это (адреса электронной почты моей компании настроены как «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") amp; "@email.email" amp; "; " amp; Range("F3") amp; "@email.email" amp; "; " amp; Range("F4") amp; "@email.email" amp; "; " amp; Range("F5") amp; "@email.email" amp; "; " amp; Range("F6") amp; "@email.email"
    .CC = ""
    .BCC = ""
    .Subject = "Report"
    .HTMLBody = "See attached" amp; "<br>" amp; .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 для каждого уникального экземпляра имени, а затем добавить расширение электронной почты? Я уверен, что есть менее сложный способ, чем тот, который у меня есть в настоящее время.

Спасибо!

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

Я бы использовал 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" amp; "<br>" amp; .HTMLBody
                .Attachments.Add ActiveWorkbook.FullName
                .Display
            End With
            email_dict.Add email_address, OutMail
        End If
        row = row   1
    Loop
End Sub