1

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
0m3r
  • 12,286
  • 15
  • 35
  • 71

2 Answers2

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

Mr.Burns
  • 690
  • 1
  • 10
  • 24
0

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!

KawaRu
  • 64
  • 1
  • 9
  • Hi! Can you show me what you mean. I am just new with VBA and still not that expert in terms of code manipulation. Thanks in advance. – Rouella May Gabinete Amponin Nov 03 '17 at 10:15
  • If you just add a range of recipients, it is probably without ";" (to seperate different recipients). Also I don't know if the `.to` can handle a range. I thought it asked for a string input. So I'd make a string, get the value of every cell and save it in that string, combined with ";" in between every recipient. Might work (works for me). – KawaRu Nov 03 '17 at 12:28