How to copy chart from excel file and paste in e-mail body

ThrottleWorks · Jun 21, 2018

Hi,

I am creating an e-mail with VBA.
E-mail body contains some text lines and a chart.

I am able to create e-mail body with text however I am not able to paste chart in e-mail.
Can anyone please help in this. Please see below code for your reference.

Set EmailRng = EmaiSht.Range("F1:Q" & TempLr) is e-mail body.
EmailSht is a worksheet in my macro.

I am supposed to paste a chart below this range. Chart is in another file.
When I use ChartSht.ChartObjects("Chart 1").Copy and paste in EmaiSht.
Blank chart window is pasted instead of proper chart.

Code:

Option Explicit
Sub Create_Email()
  Dim EmailRng As Range
  Dim OutApp As Object
  Dim OutMail As Object
 
  Dim TempLr As Long
  TempLr = EmaiSht.Cells(EmaiSht.Rows.Count, 6).End(xlUp).Row
  Set EmailRng = EmaiSht.Range("F1:Q" & TempLr)
 
  ChartSht.ChartObjects("Chart 1").Copy
  TempLr = EmaiSht.Cells(EmaiSht.Rows.Count, 6).End(xlUp).Row + 2
  EmaiSht.Cells(TempLr, 6).PasteSpecial xlPasteAll
 
  MacroBook.Activate
  EmaiSht.Select
  EmaiSht.Range("A1").Select
  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)

  Dim MyPath As String
  MyPath = ThisWorkbook.Worksheets("Mapping").Range("A2").Value
 
  Dim Signature As String
  Dim olsave As Variant
  With OutMail
  .display
  Signature = OutMail.HTMLBody
 
  .To = EmailMapSht.Range("B1").Value
  .CC = EmailMapSht.Range("B2").Value
  .Subject = EmailMapSht.Range("B3").Value
  .Attachments.Add (MapSht.Range("E10").Value)
  .Attachments.Add (MapSht.Range("E12").Value)
  .HTMLBody = RangetoHTML(EmailRng) & Signature
  .display
  End With

  Set OutMail = Nothing
  Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
  Dim fso As Object
  Dim ts As Object
  Dim TempFile As String
  Dim TempWB As Workbook
 
  Dim MacroBook As Workbook
  Dim EmailSht As Worksheet
 
  Set MacroBook = ThisWorkbook
  Set EmailSht = MacroBook.Worksheets("EmailSht")
 
  TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
  Dim TempLr As Long
  Dim EmailRng As Range
 
  TempLr = EmailSht.Cells(EmailSht.Rows.Count, 6).End(xlUp).Row
  Set EmailRng = EmailSht.Range("F1:Q100")
 
  EmailRng.Copy
  Set TempWB = Workbooks.Add(1)
  TempWB.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
  TempWB.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteFormats
 
  TempLr = Cells(Rows.Count, 1).End(xlUp).Row
 
  Dim TempSht As Worksheet
  Set TempSht = TempWB.Worksheets("Sheet1")
 
  Cells.Font.Name = "Calibri"
  Cells.Font.Size = 10
 
  With TempWB.Sheets(1)
  On Error Resume Next
  .DrawingObjects.Visible = True
  .DrawingObjects.Delete
  On Error GoTo 0
  End With
 
  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

  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=")
  RangetoHTML = Replace(RangetoHTML, "<!--[if !excel]>&nbsp;&nbsp;<![endif]-->", "")
  TempWB.Close savechanges:=False
 
  Kill TempFile

  Set ts = Nothing
  Set fso = Nothing
  Set TempWB = Nothing
End Function

Kenneth Hobson · Jun 22, 2018

So RangeToHTML() is not the problem but pasting to a worksheet is?

Maybe if you made a short example file, it would be easier to help. Click the More Options button in lower right of reply box to get the Upload button.

I would probably use the Word object if I wanted to paste to Outlook email body.

Chihiro · Jun 22, 2018

I assume chart isn't interactive? Why not just use Chart.Export and export it as jpg or other image type and put that into email?

https://msdn.microsoft.com/en-us/vba/excel-vba/articles/chart-export-method-excel

ThrottleWorks · Jun 22, 2018

Hi @Chihiro sir, thanks a lot for the help. I am trying this and will revert with details. Have a nice day ahead.

ThrottleWorks · Jul 5, 2018

I am trying below code to export chart.
However I am facing issues with it.

Instead of Chart image I see an image with below text.
The linked image cannot be displayed. The file may have been moved, renamed or deleted.
Verify that the link points to the correct file and location.

Can anyone please help me in this.
Code copied from
https://www.mrexcel.com/forum/excel-questions/562877-paste-chart-into-email-body.html

Code:

Option Explicit
Sub Create_Email()
    Dim EmailRng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim TempLr As Long
  
    MacroBook.Activate
    EmaiSht.Select
  
    TempLr = EmaiSht.Cells(EmaiSht.Rows.Count, 6).End(xlUp).Row
    Set EmailRng = EmaiSht.Range("F1:Q" & TempLr)
  
    TempLr = EmaiSht.Cells(EmaiSht.Rows.Count, 6).End(xlUp).Row + 2
  
    EmaiSht.Range("A1").Select
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Dim MyPath As String
    MyPath = ThisWorkbook.Worksheets("Mapping").Range("E8").Value
  
    Dim ChartPath As String
    ChartPath = ThisWorkbook.Worksheets("Mapping").Range("E8").Value
  
    Dim ChtObj As ChartObject
    Dim MyChartName As String
  
    For Each ChtObj In ChartSht.ChartObjects
        MyChartName = ChtObj.Name
    Next ChtObj
  
    Dim MyChartAddress As String
  
    Dim Signature As String
    Dim olsave As Variant
    With OutMail
        .display
        Signature = OutMail.HTMLBody
      
        .To = EmailMapSht.Range("B1").Value
        .CC = EmailMapSht.Range("B2").Value
        .Subject = EmailMapSht.Range("B3").Value
        .Attachments.Add (MapSht.Range("E10").Value)
        .Attachments.Add (MapSht.Range("E12").Value)
      
        ChartSht.ChartObjects("Chart 1").Chart.Export ChartPath & "\Chart1.png"
        .HTMLBody = RangetoHTML(EmailRng) & "<img src=ChartPath\Chart1.png>" & Signature
        .display
    End With
  
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
  
    Dim MacroBook As Workbook
    Dim EmailSht As Worksheet
  
    Dim OutApp As Object
  
  
    Set MacroBook = ThisWorkbook
    Set EmailSht = MacroBook.Worksheets("EmailSht")
  
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
  
    Dim TempLr As Long
    Dim EmailRng As Range
  
    TempLr = EmailSht.Cells(EmailSht.Rows.Count, 6).End(xlUp).Row
    Set EmailRng = EmailSht.Range("F1:Q100")
  
    EmailRng.Copy
    Set TempWB = Workbooks.Add(1)
    TempWB.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
    TempWB.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteFormats
  
    TempLr = Cells(Rows.Count, 1).End(xlUp).Row
  
    Dim TempSht As Worksheet
    Set TempSht = TempWB.Worksheets("Sheet1")
  
    Cells.Font.Name = "Calibri"
    Cells.Font.Size = 10
  
    With TempWB.Sheets(1)
        On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
        On Error GoTo 0
    End With
  
    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

    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=")
    RangetoHTML = Replace(RangetoHTML, "<!--[if !excel]>&nbsp;&nbsp;<![endif]-->", "")
    TempWB.Close savechanges:=False
  
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

ThrottleWorks · Jul 5, 2018

If I get values of 'ChartPath & Chart1.png' by doing Control + G and paste this RUN window. Chart file is getting opened without any issues.

Chihiro · Jul 5, 2018

Usually, I'd add image as hidden attachment and add code in HTMLBody for img.

Something similar to what's found in link below.
https://excel-macro.tutorialhorizon...-in-message-body-from-ms-outlook-using-excel/

ThrottleWorks · Jul 5, 2018

Thanks a lot @Chihiro sir. You are awesome !

Updated code.

Code:

Option Explicit
Sub Create_Email()
    Dim EmailRng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim TempLr As Long
   
    MacroBook.Activate
    EmaiSht.Select
   
    TempLr = EmaiSht.Cells(EmaiSht.Rows.Count, 6).End(xlUp).Row
    Set EmailRng = EmaiSht.Range("F1:Q" & TempLr)
   
    TempLr = EmaiSht.Cells(EmaiSht.Rows.Count, 6).End(xlUp).Row + 2
   
    EmaiSht.Range("A1").Select
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Dim MyPath As String
    MyPath = ThisWorkbook.Worksheets("Mapping").Range("E8").Value
   
    Dim ChartPath As String
    ChartPath = ThisWorkbook.Worksheets("Mapping").Range("E8").Value
   
    Dim ChtObj As ChartObject
    Dim MyChartName As String
   
    For Each ChtObj In ChartSht.ChartObjects
        MyChartName = ChtObj.Name
    Next ChtObj
   
    Dim MyChartAddress As String
    MyChartPath = (ChartPath & "Chart1.png")
   
    Dim Signature As String
    Dim olsave As Variant
    With OutMail
        .display
        Signature = OutMail.HTMLBody
       
        .To = EmailMapSht.Range("B1").Value
        .CC = EmailMapSht.Range("B2").Value
        .Subject = EmailMapSht.Range("B3").Value
        .Attachments.Add (MapSht.Range("E10").Value)
        .Attachments.Add (MapSht.Range("E12").Value)
        .Attachments.Add MyChartPath
       
        ChartSht.ChartObjects("Chart 1").Chart.Export ChartPath & "\Chart1.png"
        .HTMLBody = RangetoHTML(EmailRng) & "<img src='Chart1.png'" & "width='1200' height='800'" & Signature
        .display
    End With
   
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
   
    Dim MacroBook As Workbook
    Dim EmailSht As Worksheet
   
    Dim OutApp As Object
   
   
    Set MacroBook = ThisWorkbook
    Set EmailSht = MacroBook.Worksheets("EmailSht")
   
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
   
    Dim TempLr As Long
    Dim EmailRng As Range
   
    TempLr = EmailSht.Cells(EmailSht.Rows.Count, 6).End(xlUp).Row
    Set EmailRng = EmailSht.Range("F1:Q100")
   
    EmailRng.Copy
    Set TempWB = Workbooks.Add(1)
    TempWB.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
    TempWB.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteFormats
   
    TempLr = Cells(Rows.Count, 1).End(xlUp).Row
   
    Dim TempSht As Worksheet
    Set TempSht = TempWB.Worksheets("Sheet1")
   
    Cells.Font.Name = "Calibri"
    Cells.Font.Size = 10
   
    With TempWB.Sheets(1)
        On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
        On Error GoTo 0
    End With
   
    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

    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=")
    RangetoHTML = Replace(RangetoHTML, "<!--[if !excel]>&nbsp;&nbsp;<![endif]-->", "")
    TempWB.Close savechanges:=False
   
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

How to copy chart from excel file and paste in e-mail body

ThrottleWorks

Excel Ninja

Kenneth Hobson

Active Member

Chihiro

Excel Ninja

ThrottleWorks

Excel Ninja

ThrottleWorks

Excel Ninja

ThrottleWorks

Excel Ninja

Chihiro

Excel Ninja

ThrottleWorks

Excel Ninja