Dear Friends,
Couple of my friends asked me about this like how can I send screenshot of a particular range area of my excel sheet embedded in my HTML mail with other texts in my email. I also got this question on Microsoft Excel forum where I answered that question by providing a piece of code. Though there were some other ideas and codes which was shared by Deepak Panchal (MSFT CSG).
Code which will do the magic
Sub SendHTML_And_RangeImage_As_Body_UsingOutlook()
Dim olApp As Object
Dim NewMail As Object
Dim ChartName As String
Dim imgPath As String
On Error GoTo err
Set olApp = CreateObject("Outlook.Application")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'define a temp path for your image
tmpImageName = VBA.Environ$("temp") & "\tempo.jpg"
'Range to save as an image
Set RangeToSend = Worksheets("Sheet1").Range("A3:M27")
' Now copy that range as a picture
RangeToSend.CopyPicture Appearance:=xlScreen, Format:=xlPicture
' To save this as an Image we need to do a workaround
' First add a temporary sheet and add a Chart there
' Resize the chart same as the size of the range
' Make the Chart border as Zero
' Later once we export that chart as an image
' and save it in the above temporary path
' will delete this temp sheet
Set sht = Sheets.Add
sht.Shapes.AddChart
sht.Shapes.Item(1).Select
Set objChart = ActiveChart
With objChart
.ChartArea.Height = RangeToSend.Height
.ChartArea.Width = RangeToSend.Width
.ChartArea.Fill.Visible = msoFalse
.ChartArea.Border.LineStyle = xlLineStyleNone
.Paste
.Export Filename:=tmpImageName, FilterName:="JPG"
End With
'Now delete that temporary sheet
sht.Delete
' Create a new mail message item.
Set NewMail = olApp.CreateItem(0)
With NewMail
.Subject = "Your Subject here" ' Replace this with your Subject
.To = "abc@email.com" ' Replace it with your actual email
' **************************************************
' You can desing your HTML body for this email.
' below HTML code will display the image in
' Body of the email. It will not go in attachment.
' **************************************************
.HTMLBody = "<body>Dear Sir/Madam,
Kindly find the report below:" & _
"
<img src=" & "'" & tmpImageName & "'/>
Regards,
LearnExcelMacro.com </body>"
.Send
End With
err:
'Release memory.
' Kill tmpImageName
Set olApp = Nothing
Set NewMail = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
An Explanation : What this code does?
[checklist icon=”fa-check” iconcolor=”” circle=”” circlecolor=”” size=”13px” class=”” id=””][li_item icon=”fa-check”]Takes the Range provided by you and copy it as a Picture[/li_item][li_item icon=”fa-check”]Creates a Temp worksheet and add a Chart and paste this image in to a Blank Chart[/li_item][li_item icon=”fa-check”]Now export this chart as an Image and save it to a temp folder[/li_item][li_item icon=”fa-check”]Create your mail in Outlook and Draft your Mail in HTML as shown in the above code and then send the email.[/li_item][li_item icon=”fa-check”]Now delete the temp sheet and temp image from temp folder and release all the objects created for outlook.[/li_item][/checklist]
[content_boxes layout=”icon-on-side” columns=”1″ icon_align=”left” title_size=”” backgroundcolor=”#fff6d1″ icon_circle=”” icon_circle_radius=”” iconcolor=”” circlecolor=”” circlebordercolor=”” circlebordercolorsize=”” outercirclebordercolor=”” outercirclebordercolorsize=”” icon_size=”20″ link_type=”” link_area=”” animation_delay=”” animation_offset=”” animation_type=”0″ animation_direction=”down” animation_speed=”0.1″ margin_top=”” margin_bottom=”” class=”” id=””][content_box title=”Important” icon=”fa-bullhorn” backgroundcolor=”” iconcolor=”” circlecolor=”” circlebordercolor=”” circlebordercolorsize=”” outercirclebordercolor=”” outercirclebordercolorsize=”” iconrotate=”” iconspin=”no” image=”” image_width=”35″ image_height=”35″ link=”” linktarget=”_self” linktext=”” animation_type=”0″ animation_direction=”down” animation_speed=”0.1″]Make sure that your image is not deleted before the email is actually sent. .Send command creates the mail and trigger a send.. that is it. It does not wait for actually email to be sent from the outbox. In such case if your image is deleted before your email is actually sent, then You may see that your image is not part of the email because it was deleted before email was sent actually. This is the reason I have commented the delete statement (‘ Kill tmpImageName) of the temp image.[/content_box][/content_boxes]
Download Sample
Here is your sample workbook to play with.
is there any way to send the same range as a normal table in the outlook message?
Yes, you can do so.. here is a very famous function written by Ron De Bruin (MVP) to achieve this: https://www.rondebruin.nl/win/s1/outlook/bmail2.htm
[code language=”vb”]
Sub Mail_Selection_Range_Outlook_Body()
‘For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
‘Don’t forget to copy the function RangetoHTML in the module.
‘Working in Excel 2000-2016
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set rng = Nothing
On Error Resume Next
‘Only the visible cells in the selection
Set rng = Selection.SpecialCells(xlCellTypeVisible)
‘You can also use a fixed range if you want
‘Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = RangetoHTML(rng)
.Send ‘or use .Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
‘ Changed by Ron de Bruin 28-Oct-2006
‘ Working in Office 2000-2016
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
‘Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
‘Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
‘Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
‘Close TempWB
TempWB.Close savechanges:=False
‘Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
[/code]
thank you, it works perfect, but how should I assign a cell for “to”, “cc”, “subject” and “body”.
and is there any way to assign a cell for the new .xls file name and another one for the new .pdf file name?
thank you for your usual cooperation
Does this code work for CDO?
The temp file is not deleted
Excel sends the same file over and over
Hi there,
Thank you for the code and I tried this and most part of the code works fine. it also ends the email but when the recepients receives the email. they are not seeing the image. I can however see the image in my sent box. I didnt make any modification to the codes and have used it just like you mentioned here. I can see the image still there in my Temp folder. but all the recepient sees the image as a box with red X. please advise in how to correct this issue.
Thanks
J
Hi,
I have the same issue, the destination recipients, cannot see the image. I can see it only if I send to myself.
Can you please help me to fix it?
Have you figure this out yet?
Hi,
The code works but how do I add another screenshot of another range in the code and mail body?
Genuinely when someone doesn’t know after that its up to other users that they will help, so here it takes place.
working in my case
really thank you for your post
Hi Thank you for the code! really does work! I added to a few of the sheets I work on– however, recently when I tried to copy and paste the code to other /new sheets — the active X control button just loads and does nothing– no email appears. Is that error of the code or excel?