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
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
See the attach image to email macro in action:
Now, when the user clicks a button on the sheet, it will draft an Outlook email to all recipients listed in range A2:A101 inserted in the TO line. The body of the email will be slightly different depending on if the user clicked the checkbox if they want to include the link to the sheet or not. The preview image will automatically be copied and pasted into the email by the VBA macro.
Hope that helps! If you have any questions, please feel free
to ask using the comment form below.
How would you make it work if you change the ".Display to .Send" on the email portion?
ReplyDelete