I have been struggling with this for the last week or so and I have the following code which so long I have a Template Email (called Template Email.oft) already saved on my PC and Outlook is running when I try to run the Macro I can choose varying parameters for the email such as :
Subject, To, CC, BCC, Text in the email and I can also add up to 5 attachments.
I need to have two sheets to do this one contains the details I want for each email I wish produce (this is called "Email List"), and I have another sheet called "Control" which uses a formula to determine (E) how many emails there are in the list ( =counta(XXX) ) and another formula to determine (S) the row of the first email I wish to send. I have done this because in my email list there are some emails at the top of the list that I only want to send on certain days so I may want to start at the email on row 4 rather than on row 2.
The code then checks the various parameters to those listed on the current row for the email in question. It then opens a MessageBox displaying the details of the email it is about to send and asks if you want to send it. If you click No it looks at the next email in the list and opens a new messagebox with it's details. If you clicked yes then it opens the template email (with any signature you might have in it) and overwrites the details into it except for the body of the email where it only inserts your text any other text that is there as part of the template, so you retain the signature, it then sends the email before moving onto the next email in the list.
I must say a big thank you to Ron De Bruin and his excellent site
Mail from Excel example pages without which I would not have completed this, but I thought I would post my code as it may be useful for others to use. BTW I am sure others will be able to clean the code up a little but I am still only really beginning with VBA!
This code can be copied directly into a new module to give you a new macro called SendEmail.
Sub SendEmail()
Dim openol As Object
Dim newemail As Object 'Defines the name handle of the email template we will use
Dim A As Integer 'A is the number of attachments counted in the worksheet "Email List"
Dim AttCol As Integer 'AttCol is the current column number for the attachment to be attached to the email _
this value will be between 8 and 12 for columns H through L
Dim SubName As String 'Taken from cell values in column C in the worksheet "Email List" (Subject Name)
Dim ToName As String 'Taken from cell values in column D in the worksheet "Email List"
Dim CCName As String 'Taken from cell values in column E in the worksheet "Email List"
Dim BCCName As String 'Taken from cell values in column F in the worksheet "Email List"
Dim AttName As String 'Taken from the columns H to L in the worksheet "Email List". AttName is the _
filepath and name of any attachment.
Dim BodyText As String 'Taken from cell values in column M in the worksheet "Email List"
Dim SendEmail As Integer 'SendEmail is the MessageBox response for sending the email
Dim MAttName As String 'MAttName is the name for the Attachments used in the message box _
taken from cell values in column N in the worksheet "Email List"
Dim E As Integer 'E is the number of emails to send taken from a formula in the control sheet _
which Counts Number of emails in Email List. Value is in "Control" worksheet in Cell B3
Dim S As Integer 'S is the starting row number containing the email data on the "Email List" worksheet _
but this value is taken from cell B6 in the "Control" sheet
Sheets("Control").Select
E = Range("B3").Value
S = Range("B6").Value
Application.DisplayAlerts = False
For Z = 1 To E
Sheets("Email List").Select
SubName = Range("C" & S).Value
ToName = Range("D" & S).Value
CCName = Range("E" & S).Value
BCCName = Range("F" & S).Value
A = Range("G" & S).Value
AttCol = 8
BodyText = Range("M" & S).Value
MAttName = Range("N" & S).Value
SendEmail = MsgBox("Do you want to send the following Email?" _
& vbNewLine & vbNewLine & "Subject: " & SubName & vbNewLine & vbNewLine & _
"To: " & ToName & vbNewLine & _
"CC: " & CCName & vbNewLine & "BCC: " & BCCName & vbNewLine & vbNewLine & _
"With the following Attachments: " & vbNewLine & MAttName, _
vbQuestion + vbYesNo, "Send Email")
If SendEmail = vbYes Then
Set openol = CreateObject("Outlook.Application")
openol.Session.Logon
Set newemail = openol.CreateItemFromTemplate("C:\Users\This will be your computer user name\AppData\Roaming\Microsoft\Templates\Email Template.oft")
On Error Resume Next
With newemail
.display
.To = ToName
.CC = CCName
.BCC = BCCName
.Subject = SubName
.HTMLBody = "" & BodyText & "
" & .HTMLBody
If A > 0 Then
For Y = 1 To A
AttName = Cells(S, AttCol).Value
.Attachments.Add AttName
AttCol = AttCol + 1
Next Y
End If
.send
End With
Set openol = Nothing
Set newemail = Nothing
Else
End If
S = S + 1
Next Z
Sheets("Control").Select
Application.DisplayAlerts = True
End Sub
