Two spreadsheets I am most proud of are my Super Bowl SquaresGame Generator and my College Football Bowl Prediction Pool Manager (Bowl
Pick’em Game). I’ve put a lot of time and features into these free templates.
However, I still get many requests to add even more features. One of the most
asked questions is “how can I share the leaderboard results when all the
players aren’t connected to the same network?” I would normally respond with
how I do it: “I take a screenshot of the scoreboard and manually email it to
the players.” Then it dawned on me – why not automate this process to make it
easy for everyone to use? Why not automatically add a picture of the Excel
sheet into an email?
There are two methods I can think of off the top of my head
for attaching an image into an email with a macro, and here are the pros and
cons of each:
- The
picture is saved on your PC (or needs to be saved by the macro before
inserting into the email) – but
either way you have to know the location of the file.
- Copy
and paste an image already in your spreadsheet into an email. Does not
require saving the image. But you must know the shape name so the macro
can find it.
For today’s tutorial, I am going to show you how to use the
#2 method.
A thread on method #1 can be found here: https://stackoverflow.com/questions/44869790/embed-picture-in-outlook-mail-body-excel-vba
You can read along or scroll down to watch the video below.
Again, for this method to insert an image from a spreadsheet into an email, the
image must already be created and named manually so the macro knows what image
within the sheet to use.
Name the Shape or Image You Want to Copy and Paste From Excel into Email
First, I need to have a linked image in my spreadsheet that
will be copied to the email. Highlight the area (the cells) that you want to
have an image of, in my example the scoreboard of my Super Bowl Squares sheet.
Next, I created a new sheet within my workbook where I will collect the emails
of all the players. I right click, paste special, linked picture. Select the
image. Under page layout go to Selection Pane. Rename the picture “Preview1” or
some other descriptive name. This is what the macro will use to identify which
picture to attach to the email.
I also want to allow the user the option to include a
hyperlink to the Excel workbook in the email or not. To do this, I create a
checkbox in Excel by going to the developer tab, insert, ActiveX controls,
Check Box.
Attach Image to Email Excel Macro Code
Now it’s time to write the VBA macro that will automatically
send an email to all the players with a picture of the latest scoreboard – all
at the click of a button!
I’ve previously shared how to send an email from an Excel
sheet but this is my first time attaching an image. Below is the full code with
my comments explaining what is happening along the way.
Sub SendEmailUpdate()
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'define the workbook, location, and name
Dim Wb1 As Workbook
Set Wb1 = ThisWorkbook
Dim OwnerName As String
OwnerName = Application.UserName
Dim FileLoc As String
FileLoc = Wb1.FullName
Dim WorkbookName As String
WorkbookName = Wb1.Name
'SendEmailTo will count the number of people who the email
will be sent to
Dim SendEmailTo As Integer
SendEmailTo = 0
'we will store all the email addresses in one long string
then insert them into the TO line of the email later
Dim ToPerson As String
ToPerson = ""
'loop through all players in column A of the Send Scoreboard
sheet (up to 100 players max)
Dim x As Integer
For x = 2 To 101
' get the emails
to fill in the TO line
If Not
IsEmpty(Wb1.Worksheets("Send Scoreboard").Range("A" &
x).Value) Then
ToPerson =
Wb1.Worksheets("Send Scoreboard").Range("A" & x) &
"; " & ToPerson
SendEmailTo =
SendEmailTo + 1
Else
'MsgBox
"email is blank"
'NoSEnd = NoSEnd +
1
End If
' get the emails
to fill in the CC line
'If Not
IsEmpty(WB3.Worksheets(1).Range(CCCol & PICRow).Value) Then
'CCPerson =
WB3.Worksheets(1).Range("D" & PICRow) & "; " &
CCPerson
'CCEmail = CCEmail
+ 1
'Else
'End If
Next
MsgBox "Email will be sent to " & SendEmailTo
& " recipients."
'get the named Image to attach to the email and copy it
Set oPreview = Wb1.Worksheets("Send
Scoreboard").Shapes("Preview1")
oPreview.CopyPicture ' oPreview is now in Clipboard
'launch Outlook
Dim xOutApp As
Object
Dim xOutMail As
Object
Dim xMailBody As
String
On Error Resume
Next
Set xOutApp =
CreateObject("Outlook.Application")
Set xOutMail =
xOutApp.CreateItem(0)
'for html email
If Wb1.Worksheets("Send Scoreboard").CheckBox1.Value
= True Then
'include the link
to the spreadsheet
xMailBody =
"Hello everyone! <br><br>" & "The SuperBowl
Squares scoreboard has been updated. You can access the sheet by clicking the
link below. <br><br>" & _
"Link:
<br><br>" & "<a href=" & Chr(34) &
FileLoc & Chr(34) & " > " & WorkbookName & "
</a> " & "<br><br>" & _
"Thanks for
playing," & "<br><br>" & OwnerName
Else
'false, no link
xMailBody =
"Hello everyone! <br><br>" & "The SuperBowl Squares
scoreboard has been updated. Please see the below image:
<br><br>" & _
"Thanks for
playing," & "<br><br>" & OwnerName
End If
On Error Resume
Next
With xOutMail
.To = ToPerson
'.CC =
CCPerson
.BCC =
""
.Subject = WorkbookName
'.Body =
xMailBody
.HTMLBody =
xMailBody
.Display 'or use .Send
Quick Note: To use the clipboard to copy and paste the
picture into email, you need an Outlook mail editor which can deal with the
clipboard. Here I use WordEditor for example. The WordEditor property of the Inspector class returns an instance of
the Document class from the Word object model which represents the Body of your
email: https://docs.microsoft.com/en-us/previous-versions/office/developer/office-2007/dd492012(v=office.12)?redirectedfrom=MSD
Set oInspector
= .GetInspector
Set oWdDoc =
oInspector.WordEditor
Set oWdContent
= oWdDoc.Content
Set oWdRng =
oWdDoc.Paragraphs(1).Range
'oWdRng.InsertBefore "This is a test"
oWdRng.InsertParagraphAfter
oWdRng.InsertParagraphAfter
Set oWdRng =
oWdDoc.Paragraphs(3).Range
oWdRng.Paste '
paste from oPreview Clipboard
olFormatHTML =
2
.BodyFormat =
olFormatHTML ' change to HTML
End With
On Error GoTo 0
Set xOutMail =
Nothing
Set xOutApp =
Nothing
'---------------------------------------------------------------
ResetSettings:
'Reset Macro
Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
here.
