Skip to main content
Support is Offline
Today is our off day. We are taking some rest and will come back stronger tomorrow
Official support hours
Monday To Friday
From 09:00 To 17:30
  Friday, July 08, 2022
  0 Replies
  4.5K Visits

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.