G
gfallico
I need to automate sending a graph/pivot chart in the body of emai
using Outlook (will also have a little text). I've used the code belo
for putting text only in body of email, but can't quite figure out ho
to get the chart in there. Any help would be appreciated. Thx!
Code for putting cells in body of an email (modify slightly from code
pulled off site of Ron de Bruin):
Sub Mail_Selection_Outlook_Body()
Dim source As Range
Dim dest As Workbook
Dim myshape As Shape
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Application.ScreenUpdating = False
ActiveSheet.Copy
Set dest = ActiveWorkbook
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = "(e-mail address removed)"
.CC = ""
.BCC = ""
.Subject = "Test Message"
.HTMLBody = RangetoHTML
.Send 'or use .Display
End With
dest.Close False
Set OutMail = Nothing
Set OutApp = Nothing
Set dest = Nothing
Application.ScreenUpdating = True
End Sub
Function RangetoHTML()
Dim fso As Object
Dim ts As Object
Dim TempFile As String
TempFile = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=ActiveSheet.Name, _
source:=Selection.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
Set ts = Nothing
Set fso = Nothing
Kill TempFile
End Functio
using Outlook (will also have a little text). I've used the code belo
for putting text only in body of email, but can't quite figure out ho
to get the chart in there. Any help would be appreciated. Thx!
Code for putting cells in body of an email (modify slightly from code
pulled off site of Ron de Bruin):
Sub Mail_Selection_Outlook_Body()
Dim source As Range
Dim dest As Workbook
Dim myshape As Shape
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Application.ScreenUpdating = False
ActiveSheet.Copy
Set dest = ActiveWorkbook
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = "(e-mail address removed)"
.CC = ""
.BCC = ""
.Subject = "Test Message"
.HTMLBody = RangetoHTML
.Send 'or use .Display
End With
dest.Close False
Set OutMail = Nothing
Set OutApp = Nothing
Set dest = Nothing
Application.ScreenUpdating = True
End Sub
Function RangetoHTML()
Dim fso As Object
Dim ts As Object
Dim TempFile As String
TempFile = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=ActiveSheet.Name, _
source:=Selection.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
Set ts = Nothing
Set fso = Nothing
Kill TempFile
End Functio