PDA

View Full Version : How to send email from excel using VBA with Cell Range (Including Images) as Email Bo



raghuram.sta
03-24-2014, 01:10 AM
I want to send email from excel using VBA with Cell Range (Including Images) as Email Body, I have below code to send email as HTML body every this is coming to email body (formats & fonts) but Images are not displayed in email body. getting error "The image cannot be displayed. Your computer may not have enough memory to open the image, or the image may have been corrupted"




Sub Send_eMail()
Call eMailRangeAsBody(WksQuote.Range("D18").Value, "Quote : eMail", "B2:N61")
End Sub




Public Sub eMailRangeAsBody(strTo As String, strSubject As String, rRange As String)

Dim oBook As Excel.Workbook ' Excel workbook
Dim oSheet As Excel.Worksheet ' Excel Worksheet

Dim oOutlookApp As Object 'New Outlook.Application
Dim oOutlookMessage As Object
Dim oFSObj As Object
Dim oFSTextStream As Object
Dim rngeSend As Range
Dim strHTMLBody As String
Dim strTempFilePath As String

Set oBook = ThisWorkbook
Set oSheet = oBook.Worksheets(1)

On Error Resume Next
Set rngeSend = oSheet.Range(rRange)
If rngeSend Is Nothing Then Exit Sub
On Error GoTo 0

Set oFSObj = CreateObject("Scripting.FilesystemObject")
strTempFilePath = oFSObj.GetSpecialFolder(2)
strTempFilePath = strTempFilePath & "\XLRange.htm"

oBook.PublishObjects.Add(4, strTempFilePath, _
oSheet.Name, rRange, 0, "", "").Publish True

Set oOutlookApp = CreateObject("Outlook.Application")

Set oOutlookMessage = oOutlookApp.CreateItem(0)

Set oFSTextStream = oFSObj.OpenTextFile(strTempFilePath, 1)

strHTMLBody = oFSTextStream.ReadAll

strHTMLBody = Replace(strHTMLBody, "align=center", "align=left", _
, , vbTextCompare)

oOutlookMessage.HTMLBody = strHTMLBody
oOutlookMessage.HTMLBody = strHTMLBody
oOutlookMessage.To = strTo
oOutlookMessage.Subject = strSubject

'Attach images to email
txtFpath = "C:\Images\"
Pathf = fs.GetFolder(txtFpath)
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(Pathf)
On Error Resume Next
iCol = 4
For Each myFile In mySource.Files
If Left(myFile.Name, 14) = WksQuote.Range("I8").Value Then 'Attach all Quote related images
FilePath = myFile
oOutlookMessage.Attachments.Add (FilePath)
End If
Next




oOutlookMessage.Display

Call DeleteFile(strTempFilePath)

Set oBook = Nothing
Set oFSTextStream = Nothing
Set oOutlookMessage = Nothing
Set oOutlookApp = Nothing
Set oFSObj = Nothing
End Sub

Some one please help me

patel
03-24-2014, 01:47 AM
crossposting

http://www.excelforum.com/excel-programming-vba-macros/998922-how-to-send-email-from-excel-using-vba-with-cell-range-including-images-
as-email-body.html

raghuram.sta
03-24-2014, 02:14 AM
crossposting


I couldn't find how to link back....

However no solution yet..!! :(

patel
03-24-2014, 04:21 AM
from FAQ multiposting
If you must post your question on a different forum, include a link to the question you have already posted on the previous forum(s). That way, those helping you can decide for themselves if you are already receiving the help you need somewhere else.