Macro that sends emails with embedded images, but images not displaying on all mail apps

Guys,

This is my first post here, but i have been using your forums for quite some time. Even though my skills have developed, i have run into some trouble now with a macro that sends an excel range as an image in an outlook email. I am using 2010 Excel and Outlook.

The problem that i have is as follows, I am able to send the images and attachments as i need and want to, however the images are only displayed in the body of the email when the email is opened in outloook. When i open it in another mail program the only thing that appears is a box the size of the image with the image source name in the upper left hand. The code i am using is below, it is by no means perfect, if you have feedback suggestions i am definitely open to it. The main issue i am trying to solve is the display of images in other mail apps. Here is the code:

Sub Macro1()
'
' Macro1 Macro
'
Dim pvt As PivotTable
Dim ws As Worksheet
Dim wb As Workbook

For Each ws In ActiveWorkbook.Worksheets
For Each pvt In ws.PivotTables
With pvt
.HasAutoFormat = False
.SaveData = False
End With
Next pvt
Next ws
End Sub


Sub sendMail()
Application.Calculation = xlManual
ActiveWorkbook.RefreshAll
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Dim TempFilePath As String

Sheets("Output").Select

Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String
Dim dt As String
'Dim colAttach As Outlook.Attachments
'Dim oAttach As Outlook.Attachment


' Define PDF filename
dt = Format(CStr(Date - 1), "mm.dd.yy")
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & dt & ".pdf"

' Export activesheet as PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With

' Delete PDF file
'Kill PdfFile


'Create a new Microsoft Outlook session
Set appOutlook = CreateObject("outlook.application")
'create a new message
Set Message = appOutlook.CreateItem(olMailItem)
' Set colAttach = oEmail.Attachments
' Set oAttach = colAttach.Add("C:\temp\logo.jpg")
' Set olkPA = oAttach.PropertyAccessor

With Message
.Subject = "CONFIDENTIAL: Daily Financial Flash as of " & (Date - 1)


.HTMLBody = "<span LANG=EN>" _
& "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
& "Team,<br ><br >Daily Metrics Below: " _
& "<br ><br > " _
& "<br>For questions contact me.<BR>"

'first JPG file
Call createJpg("Output", "A32:L60", "RevenueGrowth")
'we attached an invisible the embedded image
TempFilePath = Environ$("temp") & "\"
.Attachments.Add TempFilePath & "RevenueGrowth.jpg", olByValue


'second JPG file currently comented out
Call createJpg("Output", "A63:L90", "DailyRevenue")
'we attached an invisible the embedded image
TempFilePath = Environ$("temp") & "\"
.Attachments.Add TempFilePath & "DailyRevenue.jpg", olByValue
'Then we add an html <img src=''> link to this image
'Note than you can customize width and height - not mandatory
'& "<img src='cid:DashboardFile2.jpg'"this goes below after the <BR> stuff

.HTMLBody = .HTMLBody & "<br><B>Daily Metrics:</B><br>" _
& "<br><B>Revenue Growth</B><br>" _
& "<img src=""cid:RevenueGrowth.jpg""" _
& "<br ><br >" _
& "<br><B>Daily Revenue</B><br>" _
& "<img src=""cid:DailyRevenue.jpg""" _
& "<br>Cheers,<br ><br >SRA</font></span>"

.To = "dd@email.com"
.CC = ""
.Attachments.Add PdfFile
.Display
'.Send
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Application.Calculation = xlCalculationAutomatic
End Sub

Sub createJpg(Namesheet As String, nameRange As String, nameFile As String)
ThisWorkbook.Activate
Worksheets(Namesheet).Activate
Set Plage = ThisWorkbook.Worksheets(Namesheet).Range(nameRange)
Plage.CopyPicture
With ThisWorkbook.Worksheets(Namesheet).ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
End With
Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Delete
Set Plage = Nothing
End Sub


Let me know if you need more info, or if i should post this differently. Thanks for all your help so far...this is an awesome forum.

Hey
I have a doubt on this code ...

Please Login or Register  to view this content.

How can i change the name of the sheet (ex:"Output") for an active sheet. Because when i copy a sheet the code don't work anymore because the reference name.
Please, help.