Add a chart to the body of an email

[NewOrderFac33]

Good morning,

I have been using Ron De Bruin's email generating code for a while now:

Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = EmailAddress
        .CC = ""
        .BCC = ""
        .Subject = "JIRA Releases in Released to UAT status"
        .HTMLBody = MsgBody
        '.attachments.Add "C:\Pete's Stuff\Sample Attachment.xlsx"
        .Display
        '.Send
    End With
    
    Set OutMail = Nothing
    Set OutApp = Nothing

but would like to know if there is any way in which I can embed a named worksheet chart (not a chart tab) into the body of the email before it is previewed or sent?

Thanks in advance for your help.

Pete

 

[NewOrderFac33]

Classic case of "Google it first" (although this adds the chart as an an attachment, rather than embedding it in the email body, so still open to suggestions)

Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
    
'File path/name of the gif file
Dim FName As String
FName = Environ$("temp") & "\ReleasedToUAT.gif"

'EITHER:
'Save chart sheet with the name "Chart" as GIF file
'ActiveWorkbook.Sheets("Chart").Export FileName:=FName, FilterName:="GIF"
  
'OR:
'Save worksheet chart with the name "RTUATChart" as GIF file
ActiveWorkbook.Worksheets("Chart").ChartObjects("RTUATChart").Chart.Export FileName:=FName, FilterName:="GIF"
    
With OutMail
    .To = EmailAddress
    .CC = ""
    .BCC = ""
    .Subject = "JIRA Releases in Released to UAT status"
    .HTMLBody = MsgBody
    '.attachments.Add "C:\Pete's Stuff\Sample Attachment.xlsx"
    .attachments.Add FName
    .Display
    '.Send
End With
    
'Delete the gif file
Kill FName
    
Set OutMail = Nothing
Set OutApp = Nothing

Pete

 

[NewOrderFac33]

This works, pasting the chart in immediately before the rest of MsgBody. HOWEVER, it now throws up the message:

"A program is trying to access e-mail address information stored in Outlook. If this is unexpected, click Deny and verify your antivirus software is up to date."

There are three buttons displayed, "Allow", "Deny" and "Help". If I click "Allow", my code continues to work fine.

Is there any way in which I can suppress this message?

Dim OutApp As Object
    Dim OutMail As Object
    Dim wEditor As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    'Set path/name of the GIF file
    Dim GIFName As String
    GIFName = Environ$("temp") & "\ReleasedToUAT.GIF"
    
    'Save chart sheet with the name "Chart" as GIF file
    'ActiveWorkbook.Sheets("Chart").Export FileName:=FName, FilterName:="GIF"
    
    'Save Worksheet chart with the name "RTUATChart" as GIF file
    ActiveWorkbook.Worksheets("Chart").ChartObjects("RTUATChart").Chart.Export FileName:=GIFName, FilterName:="GIF"
    
    
    Application.DisplayAlerts = False
    Sheets("Chart").ChartObjects("RTUATChart").Activate
    ActiveChart.PlotArea.Select
    ActiveChart.ChartArea.Copy
    
    With OutMail
        .To = EmailAddress
        .CC = ""
        .BCC = ""
        .Subject = "JIRA Releases in Released to UAT status"
        .HTMLBody = MsgBody
        '.attachments.Add "C:\Pete's Stuff\Sample Attachment.xlsx"
        .attachments.Add GIFName
        .Display
        '.Send
    End With
    
    Set wEditor = OutApp.ActiveInspector.wordEditor
    wEditor.Application.Selection.Paste
    Application.CutCopyMode = False
    
    'Delete the GIF file
    Kill GIFName
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set wEditor = Nothing
    Application.DisplayAlerts = True
    Sheets("Database").Activate

Regards

Pete

 

[vds1]

*Please Ignore*

 

[vds1]

Hi Pete,

Here is the one more approach. I have added extra space for HTML tags. You need to Replace "< " to "<" and " >" to ">" before using the below code.

Sub Chart_Email_Body()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Dim StartMsg As String, Msgbody As String, endmsg As String
    
'//File path/name of the gif file
Dim FName As String
FName = Environ$("temp") & "\ReleasedToUAT.gif"

'//Save Chart named "RTUATChart" as gif file
ActiveWorkbook.Worksheets("Chart").ChartObjects("RTUATChart").Chart.Export Filename:=FName, FilterName:="GIF"

StartMsg = "< font size='5' color='black' > Hi There," & "< br > < br >" & "Please find the chart below: " & "< br > < br > < /font >"
Msgbody = "< p align='Left' >< img src=" & FName & """  width=500 height=300  > < br > < br >"
endmsg = "< font size='4' color='black' > Many Thanks," & "< br >" & "vds1" & "< br > < br > < /font >"

'//Set wEditor = OutApp.ActiveInspector.wordeditor
With OutMail
    .To = EmailAddress
    .CC = ""
    .BCC = ""
    .Subject = "JIRA Releases in Released to UAT status"
    .HTMLBody = StartMsg & Msgbody & endmsg
    '.attachments.Add "C:\Pete's Stuff\Sample Attachment.xlsx"
    '.attachments.Add FName
    .Display
    '.Send
End With

'//Delete the gif file
Kill FName

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

 

[NewOrderFac33]

VDS1 - this is brilliant - exactly what I wanted! Thank you VERY much indeed!

Pete

 

[vds1]

VDS1 - this is brilliant - exactly what I wanted! Thank you VERY much indeed!

Pete

Thank you for your response. Have a good day.