Note: The other languages of the website are Google-translated. Back to English
English English
  Friday, 08 July 2022
  0 Replies
  1.5K Visits
0
Votes
Undo

Sub mailHTMLsend()
'Updated by Extendoffice 2018/3/5
Dim xOutApp As Object
Dim xOutMail As Object
Dim xStartMsg As String
Dim xEndMsg As String
Dim xChartName As String
Dim xChartPath As String
Dim xPath As String
Dim xChart As ChartObject
On Error Resume Next
xChartName = Application.InputBox("Please enter the chart name:", "KuTools for Excel", , , , , , 2)
If xChartName = "" Then Exit Sub
Set xChart = Sheets("Sheet1").ChartObjects(xChartName) 'Change "Sheet1" to your worksheet name
If xChart Is Nothing Then Exit Sub
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xStartMsg = "<font size='5' color='black'> Good Day," & "<br/> <br/>" & "Please find the chart below: " & "<br/> <br/> </font>"
xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br/> <br/> </font>"
xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
xPath = "<p align='Left'><img src="/"" & cid: & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """ width=700 height=500 "/"> <br/> <br/>"
xChart.Chart.Export xChartPath
With xOutMail
.To = "xrr@163.com"
.Subject = "Add Chart in outlook mail body"
.Attachments.Add xChartPath
.HTMLBody = xStartMsg & xPath & xEndMsg
.Display
End With
Kill xChartPath
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

There are no replies made for this post yet.

Follow Us

Copyright © 2009 - www.extendoffice.com. | All rights reserved. Powered by ExtendOffice. | Sitemap
Microsoft and the Office logo are trademarks or registered trademarks of Microsoft Corporation in the United States and/or other countries.
Protected by Sectigo SSL