使用 Excel VBA 根据常见的单元格值向多人发送电子邮件

Question

I would like to add multiple recipients and attachments to one email message dictated by the value in a column.

I need to have people update their resumes, which will be attached, but I would like to group the emails by manager. The # of people under each manager ranges from 1-14.

The columns I have are:
B: Mgr Email address
C: Mgr last name
D: Employee email
E: Emp first name
F: Emp last name
G: Status of resume

I created a macro that will loop through and create an email with proper attachment for each entry.

I'd like to switch this to groups of employees by the value in column C or B. I have an inkling this will include arrays. I am a VBA novice.

What I have so far (with specific paths/emails renamed for privacy):

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

If I'm guessing correctly at what you want, here's a way that uses a collection of e-mails by manager. They are created as you go, and then when you're finished, you can do whatever you want to the messages in the collection.

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

Caveat: Given that I don't have your data and don't use Outlook presently, I have not tested the above code snippet. The snippet primarily replaces your For...Next Loop, with an additional loop and clean up at the end, some declarations at the beginning. Let me know if it gives you problems, and I'll try to fix this answer based on what you tell me.