Ndtyjky

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

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...NextLoop, 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.