Отправка электронной почты нескольким людям на основе общего значения ячейки с помощью Excel VBA

Question

Я хотел бы добавить несколько получателей и вложений в одно сообщение электронной почты, продиктованное значением в столбце.

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

У меня есть следующие столбцы:
B: Mgr Адрес электронной почты
C: Mgr фамилия
D: электронная почта сотрудника
E: Emp имя
F: Emp фамилия
G: Статус резюме

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

Я хотел бы переключить это на группы сотрудников по значению в столбце C или B. У меня есть предположение, что это будет включать массивы. Я новичок VBA.

Что у меня есть (с конкретными путями / электронными письмами, переименованными для конфиденциальности):

Sub Test2()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim sSourcePath As String
Dim flpath As String
flpath = "C:\Resumes\"

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
    'XYZ email address was hardcoded for testing purposes, but should also loop
    If cell.Value = "XYZ@gmail.com" And _
       Cells(cell.Row, "G").Value = "4. Need Update" _
       Then

        Set OutMail = OutApp.CreateItem(0)
        sSourcePath = Dir(flpath & Cells(cell.Row, "E").Value & " *.docx")

        On Error Resume Next
        With OutMail
            .To = cell.Value & ", " & Cells(cell.Row, "D").Value
            'cced address is static
            .CC = "ZZZ@gmail.com" 
            .Subject = "Resume needed"
            .body = "Howdy!" _
                  & vbNewLine & vbNewLine & _
                    "Body text"

            .attachments.Add flpath & sSourcePath
            .Display  'Or use Display

        End With
        On Error GoTo 0
        Set OutMail = Nothing
    End If

Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Answer 1

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

Dim allMessages as Collection
Dim currMessage as Object
Set allMessages = New Collection

For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
    If Cells(cell.Row, "G").Value = "4. Need Update"
        ' Find the e-mail for the present manager
        For Each currMessage in allMessages
            If currMessage.CC = cell.Value Then
                Exit For
            End If
        Next currMessage

        ' Create it, if it wasn't found
        If currMessage Is Nothing Then
            Set currMessage = OutApp.CreateItem(0)
            allMessages.Add currMessage
            With currMessage
                .CC = cell.Value
                .Subject = "Résumé Needed"
                .Body = "Howdy!" & vbNewLine & vbNewLine & "Body text."
            End With
        End If

        ' Add the Message Recipient and Attachment
        sSourcePath = Dir(flpath & Cells(cell.Row, "E").Value & " *.docx")
        With currMessage
            .To = .To & Iif(Len(.To) > 0,";","") & _
                  cell.Value & ", " & Cells(cell.Row, "D").Value
            .Attachments.Add flpath & sSourcePath
        End With

        Set currMessage = Nothing

    End If
Next cell

' Now do something with the messages.
For Each currMessage In allMessages
    currMessage.Display
End If

Set currMessage = Nothing
Set allMessages = Nothing

Предупреждение: Учитывая, что у меня нет ваших данных и я не использую Outlook в настоящее время, я не тестировал приведенный выше фрагмент кода. Фрагмент в первую очередь заменяет ваш цикл For...Next дополнительным циклом и очищает в конце некоторые объявления в начале. Дайте мне знать, если это вызовет у вас проблемы, и я постараюсь исправить этот ответ, основываясь на том, что вы мне сказали.