Sending Outlook Email with multiple recipients fro

Question

I am currently doing a VBA-macro that would send a SINGLE outlook email having the following criteria:

A. The recipients are listed in column D of Sheet1 and all I want is to concatenate each sender in TO field of outlook. However, these recipients are dynamic and could be different in terms of number. Cases may lead to adding or subtracting email addresses from these column.

B. I need to paste whatever the content of Sheet2 in the BODY field of outlook. C. I need to generate an email with signature.

So far, I have this code but it's not working though:

Option Explicit

Sub SendEmail()

Dim OutlookApplication As Outlook.Application
Dim OutlookMailItem As Outlook.MailItem
Dim outlookInspector As Outlook.Inspector
Dim wdDoc As Word.Document
Dim Recipient As Range
Dim CC As Range

Application.ScreenUpdating = False

Set OutlookApplication = New Outlook.Application
Set OutlookMailItem = OutlookApplication.CreateItem(0)

'On Error GoTo cleanup

    Workbooks("ConfigFile.xlsm").Sheets("Sheet1").Activate

    Range("D2").Select
    Set Recipient = Range(ActiveCell, ActiveCell.End(xlDown))

    Range("E2").Select
    Set CC = Range(ActiveCell, ActiveCell.End(xlDown))

    With OutlookMailItem
        .Display
        .To = Recipient
        .CC = CC
        .subject = ThisWorkbook.Sheets("Sheet1").Range("F2").Value
        .Body = ThisWorkbook.Sheets("Sheet1").Range("G2").Value

        Set outlookInspector = .GetInspector
        Set wdDoc = outlookInspector.WordEditor

        wdDoc.Range.InsertBreak

        Sheet2.Activate
        Range("A:A").CurrentRegion.Copy

        wdDoc.Range.Paste

    End With


'cleanup:
    'Set OutlookApplication = Nothing
    'Application.ScreenUpdating = True

End Sub

Answer 1

To answer the first part of your question, replace the .To & .CC with:

Dim myDelegate As Outlook.Recipient

    For Each sTo In Recipient
        Set myDelegate = OutlookMailItem.Recipients.Add(sTo)
        myDelegate.Resolve
        If Not myDelegate.Resolved Then
            myDelegate.Delete
        End If
    Next sTo

    For Each sTo In CC
        Set myDelegate = OutlookMailItem.Recipients.Add(sTo)
        myDelegate.Type = olCC
        myDelegate.Resolve
        If Not myDelegate.Resolved Then
            myDelegate.Delete
        End If
    Next sTo

This loops through each of the people you have in column D & E and will input them into the relevant fields, in the case of someone not existing it will remove that person, if you don't want this to happen simply remove the If statement in each of the loops above

Your other 2 questions should be asked separately but a quick Google search found similar issue which may help you

For pasting data from Excel to Outlook Body

For Email signature

What I used for the .To & .CC To answer your question, you may want to look at them, they may help you in the future

Answer 2

I solved this by adding all these seperated recipients to one string. Getting them cell by cell and add them to a string, provided with ";" where needed :)

Don't know if it works with a range.. I think that's the problem.

Hope it helps!