Send email from excel with image
 

Hello-

I have code that sends our departments call handling statistics every
half hour via outlook. The stats are created in excel, then sent with
outlook. I am trying to get the same code to send representative stats
each morning that would include a picture based on their overall calls
handled the previous day. The code works to add the pictures from a
folder that I have set up, but the code that sends the email from
outlook will not include the image file when sending. I have attached
the code below. I would greatly appreciate any assistance with this. I
think I may need to either attached the image to a command button
placed on the spreadsheet (don't know how to put the image on through
vba though) or take the spreadsheet range and do a "copy as picture"
function then have that info placed in the email body. I've tried both
and am stuck at this point.

After the image is inserted into my spreadsheet, I use to code samples
I found, one that emails through excel to outlook, and another that
attaches the selected range as an HTML message in the body of the
email.


Sub SendStats()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Sheets("AgentReport").Range("A1:I26")
On Error GoTo 0

If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is
protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = Sheets("AgentReport").Range("E2").Value
.CC = ""
.BCC = ""
.Subject = "Agent Daily Call Stats"
.HTMLBody = RangetoHTML(rng)
.Send


End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
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

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-
ss") & ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
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

'Read all data from the htm file into RangetoHTML
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=")

'Close TempWB
TempWB.Close SaveChanges:=False

'Delete the htm file we used in this function
Kill TempFile

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

Send email from excel with image
 

Hi Scott

See
http://www.rondebruin.nl/mail/folder3/mailenvelope.htm

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Scott" wrote in message ...
Hello-

I have code that sends our departments call handling statistics every
half hour via outlook. The stats are created in excel, then sent with
outlook. I am trying to get the same code to send representative stats
each morning that would include a picture based on their overall calls
handled the previous day. The code works to add the pictures from a
folder that I have set up, but the code that sends the email from
outlook will not include the image file when sending. I have attached
the code below. I would greatly appreciate any assistance with this. I
think I may need to either attached the image to a command button
placed on the spreadsheet (don't know how to put the image on through
vba though) or take the spreadsheet range and do a "copy as picture"
function then have that info placed in the email body. I've tried both
and am stuck at this point.

After the image is inserted into my spreadsheet, I use to code samples
I found, one that emails through excel to outlook, and another that
attaches the selected range as an HTML message in the body of the
email.


Sub SendStats()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Sheets("AgentReport").Range("A1:I26")
On Error GoTo 0

If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is
protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = Sheets("AgentReport").Range("E2").Value
.CC = ""
.BCC = ""
.Subject = "Agent Daily Call Stats"
.HTMLBody = RangetoHTML(rng)
.Send


End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
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

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-
ss") & ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
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

'Read all data from the htm file into RangetoHTML
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=")

'Close TempWB
TempWB.Close SaveChanges:=False

'Delete the htm file we used in this function
Kill TempFile

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