Pulling multiple emails from data table & making separate emails based on the same template

Question

I am trying to pull email addresses from a column in an Excel Data table and have those email addresses be the receiver of email based on a template.

Code I made below.

Sub Mail_experiment()
   Dim OutApp As Outlook.Application
   Dim OutMail As Outlook.Mailtem
   Set OutApp = CreateObject("Outlook.Application")
   Set = OutMail
OutApp.CreatItemFromTemplate("C:\Users\Name\Documents\Project\PO Accrual Support Email Template.oft")
On Error Resume Next
With OutMail
   .To = "J.Doe@gmail.com"
   .CC = ""
   .BC = ""
   .Subject = ""
   .Save


End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

All separate emails will be sent later, hence .Save. Also, I am attempting to pull what would be the subject line of the email from another column in the data table.

How would I achieve both concepts with what I have so far?

Answer 1

You should create a function that returns a new MailItem based on your template. In this way, you will be able to test the new MailItem separately without having to run the complete code.

I like to enumerate my excel columns. This makes it both easier to refer to the correct column and to update the code if the column order is changed.

Option Explicit
'Enumeration is by defination the action of establishing the number of something
'I Enumerate my Worksheet Columns to give them a meaningful name that is easy to recognize
Public Enum EmailColumns
    ecEmailAdresses = 1
    ecSubject = 3
End Enum

Public Sub SaveEmails()
    Dim r As Long
    'The With Statement allows you to "perform a series of statements on a specified object without specifying the name of the object multiple times"
    '.Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row actually refers to ThisWorkbook.Worksheets("Support Emails").Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row
    With ThisWorkbook.Worksheets("Support Emails")
        '.Cells(): references a cell or range of cells on Worksheets("Support Emails")
        '.Cells(.Rows.Count, ecEmailAdresses): Refrences the last cell in column 1 of the worksheet
        '.End(xlUp): Changes the refererence from the last cell to the first used cell above the last cell in column 3
        '.Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row: returns the Row number of the last used cell in column 3
        For r = 2 To .Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row
            getPOAccrualTemplate(MailTo:=.Cells(r, ecEmailAdresses), Subject:=.Cells(r, ecEmailAdresses)).Save
        Next
    End With
End Sub

Public Function getPOAccrualTemplate(MailTo As String, Optional CC As String, Optional BCC As String, Optional Subject As String) As Object
    Const TEMPLATE_PATH As String = "C:\Users\Name\Documents\Project\PO Accrual Support Email Template.oft"
    Dim OutApp As Object, OutMail As Object
    ' CreateObject("Outlook.Application"): Creates an instance of an Outlook Application.
    ' Outlook.Application.CreateItemFromTemplate returns a new MailItem Based on a saved email template
    Set OutMail = CreateObject("Outlook.Application").CreateItemFromTemplate(TEMPLATE_PATH)

    With OutMail
        .To = MailTo
        .CC = CC
        .BCC = BCC
        .Subject = Subject
    End With
    'Returns the new MailItem to the caller of the function
    Set getPOAccrualTemplate = OutMail

End Function

Immediate Window Tests

'Test getPOAccrualTemplate
' Assign Values to Varaible
MailTo   = "ti@stackoverflow.com"
CC       = "efrenreyes@youdontwantnoneson.com"
BCC      = "alexp@gmail.com"
Subject  = "Who is going to the tournament tonight?"
'Test Variables using "," to insert Tabs between values
?MailTo, CC, BCC, Subject
?MailTo;"-";CC;"-";BCC;"-";Subject
'Pass variables into getPOAccrualTemplate and return a new MailItem based on the template
'variables created in the immediate window are Variant Type
'CStr is used to cast the values to Strings
set OutMail = getPOAccrualTemplate(CStr(MailTo), CStr(CC), CStr(BCC), CStr(Subject))
'Find out what type of object was returned 
?TypeName(OutMail)
'Display the Mail Item
OutMail.Display
'Test Enumerate Columns
Columns(EmailColumns.ecEmailAdresses).Select
Columns(ecSubject).Select
MailTo   = Cells(2, ecEmailAdresses)
CC       = ""
BCC      = ""
Subject  = Cells(2, ecSubject)
'Test the function directly
getPOAccrualTemplate(CStr(MailTo), CStr(CC), CStr(BCC), CStr(Subject)).Display
'Test SaveEmails() Make sure and add a breakpoint 
SaveEmails
?.Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row

Video Tutorials

These are two videos from my favorite VBA tutorial series that are relevant:

• Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset)
• Excel VBA Introduction Part 26 - Constants and Enumerations (Const, Enum)

Answer 2

You should just slightly refactor your code. The macro sending the email should take (at least) the email adress and the subject in parameter:

Sub Mail_experiment(ByVal address As String, ByVal subject As String)
   Dim OutApp As Outlook.Application
   Dim OutMail As Outlook.Mailtem
   Set OutApp = CreateObject("Outlook.Application")
   Set = OutMail
   OutApp.CreatItemFromTemplate("C:\Users\Name\Documents\Project\PO Accrual Support Email Template.oft")
   On Error Resume Next
   With OutMail
   .To = address '<-- use the input here
   .CC = ""
   .BC = ""
   .Subject = subject '<-- use the input here
   .Save
   End With
   On Error GoTo 0
   Set OutMail = Nothing
   Set OutApp = Nothing
End Sub

Hence, supposing you have the email addresses in the column A and the subjects in the column B (from 1 to 10, for example), you'd just need to call the macro in a loop:

For j = 1 To 10
    Mail_experiment Range("A" & j), Range("B" & j)
Next j

The above will call the Mail_experiment macro 10 times, each time passing a new parameter (A1 - B1, then A2 - B2 etc.)