Dear All,
I'm trying to paste a Excel range into Outlook as bitmap image.
And save the mail in drafts folder.
I'm struggling with the Paste code for this. Can anyone help?
:furious:
thanks and regards
Youtham
Dear All,
I'm trying to paste a Excel range into Outlook as bitmap image.
And save the mail in drafts folder.
I'm struggling with the Paste code for this. Can anyone help?
:furious:
thanks and regards
Youtham
Re: Trying to paste a range into Outlook as bitmap image
What code you got so far Youtham?
Re: Trying to paste a range into Outlook as bitmap image
Thanks Andy
i got this code from dicks-blog.com
Searched and tried many more in web. This is much closer than other
Sub Email_HoldOvers()
Dim SB
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim sSubject, sTo As String
Dim ExcelApp As Excel.Application
Dim ExcelXls As Excel.Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
SB = ThisWorkbook.Sheets("BC").Range("I2")
sTo = "" ' put the address's in here I left it blank so you can test it
sSubject = SB
Application.CutCopyMode = False
ThisWorkbook.Sheets("BC").Activate
ThisWorkbook.Sheets("BC").Range("A1:G16").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
On Error Resume Next
Set ExcelApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set ExcelApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set ExcelXls = ExcelApp.Workbooks.Add
ExcelXls.Activate
ActiveSheet.Paste
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayZeros = False
Application.CutCopyMode = False
With OutMail
.To = sTo
.Subject = sSubject
.BodyFormat
.HTMLBody = SheetToHTML(ActiveSheet)
.Save
End With
Set OutMail = Nothing
Set OutApp = Nothing
ExcelXls.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Public Function SheetToHTML(sh As Worksheet)
Dim TempFile As String
Dim fso As Object
Dim ts As Object
Dim sTemp As String
Randomize
sh.Copy
TempFile = sh.Parent.Path & "TmpHTML" & Int(Rnd() * 10) & ".htm"
ActiveWorkbook.SaveAs TempFile, xlHtml
ActiveWorkbook.Close False
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
sTemp = ts.ReadAll
SheetToHTML = ConvertPixToWeb(sTemp, sh) 'this line is new
ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile
End Function
Public Function ConvertPixToWeb(sHTML As String, sh As Worksheet) As String
Dim Pic As Picture
Dim lGif As Long
Dim lSrcStr As Long
Dim lSrcEnd As Long
Dim sUrl As String
Dim i As Long
For Each Pic In sh.Pictures
i = i + 1
lGif = InStr(1, sHTML, Format(i, "000")) '& ".gif")
lSrcStr = InStrRev(sHTML, Chr$(34), lGif)
lSrcEnd = lGif + Len(Format(i, "000")) '& ".gif")
sUrl = Chr$(34) & sh.Shapes(Pic.Name)
sHTML = Replace(sHTML, Mid(sHTML, lSrcStr, lSrcEnd - lSrcStr + 1), sUrl)
Next Pic
ConvertPixToWeb = sHTML
End Function
Display More
regards Youtham
Re: Trying to paste a range into Outlook as bitmap image
Have a look at this code by Outlook MVP Neo
To add an embedded image to an HTML message
Re: Trying to paste a range into Outlook as bitmap image
Where does that come from?
I just tried Neo's example with no problems.
Re: Trying to paste a range into Outlook as bitmap image
Andy
i can't see the image embedded in mail body
Mail body shows small box with a red X
i want the mail body to show the attached image
regards, Youtham
Re: Trying to paste a range into Outlook as bitmap image
Dear Andy
tools reference CDO for NTS 1.2 library and CDO for windows 2000 library
this is the code. i used
Sub EmbeddedHTMLGraphicDemo()
' Outlook objects
Dim objApp As Outlook.Application
Dim l_Msg As MailItem
Dim colAttach As Outlook.Attachments
Dim l_Attach As Outlook.Attachment
Dim oSession As Object 'MAPI.Session
' CDO objects
Dim oMsg As Object 'MAPI.Message
Dim oAttachs As Object 'MAPI.Attachments
Dim oAttach As Object 'MAPI.Attachment
Dim colFields As Object 'MAPI.Fields
Dim oField As Object 'MAPI.Field
Dim strEntryID As String
' create new Outlook MailItem
Set objApp = CreateObject("Outlook.Application")
Set l_Msg = objApp.CreateItem(olMailItem)
' add graphic as attachment to Outlook message
' change path to graphic as needed
Set colAttach = l_Msg.Attachments
Set l_Attach = colAttach.Add("c:\AIAIAI.jpg")
l_Msg.Close olSave
strEntryID = l_Msg.EntryID
Set l_Msg = Nothing
' *** POSITION CRITICAL *** you must dereference the
' attachment objects before changing their properties
' via CDO
Set colAttach = Nothing
Set l_Attach = Nothing
' initialize CDO session
On Error Resume Next
Set oSession = CreateObject("MAPI.Session")
oSession.Logon "", "", False, False
' get the message created earlier
Set oMsg = oSession.GetMessage(strEntryID)
' set properties of the attached graphic that make
' it embedded and give it an ID for use in an <IMG> tag
Set oAttachs = oMsg.Attachments
Set oAttach = oAttachs.Item(1)
Set colFields = oAttach.Fields
Set oField = colFields.Add(CdoPR_ATTACH_MIME_TAG, "image/jpeg")
Set oField = colFields.Add(&H3712001E, "myident")
oMsg.Fields.Add "{0820060000000000C000000000000046}0x8514", 11, True
oMsg.Update
' get the Outlook MailItem again
Set l_Msg = objApp.GetNamespace("MAPI").GetItemFromID(strEntryID)
' add HTML content -- the <IMG> tag
l_Msg.HTMLBody = "<html><p>This is a picture.</p>" & _
"<img src='cid:AIAIAI.jpg'>"
l_Msg.Close (olSave)
l_Msg.Display
' clean up objects
Set oField = Nothing
Set colFields = Nothing
Set oMsg = Nothing
oSession.Logoff
Set oSession = Nothing
Set objApp = Nothing
Set l_Msg = Nothing
End Sub
Display More
regards, Youtham
Re: Trying to paste a range into Outlook as bitmap image
still same problem
regards, Youtham
Re: Trying to paste a range into Outlook as bitmap image
I can get the red cross if I leave out the cid: for <img src=myident>
This routine works for me using xl2003 and outlook 2003
Sub EmbeddedHTMLGraphicDemo()
' Outlook objects
Dim objApp As Outlook.Application
Dim l_Msg As MailItem
Dim colAttach As Outlook.Attachments
Dim l_Attach As Outlook.Attachment
Dim oSession As Object 'MAPI.Session
' CDO objects
Dim oMsg As Object 'MAPI.Message
Dim oAttachs As Object 'MAPI.Attachments
Dim oAttach As Object 'MAPI.Attachment
Dim colFields As Object 'MAPI.Fields
Dim oField As Object 'MAPI.Field
Dim strEntryID As String
' create new Outlook MailItem
Set objApp = CreateObject("Outlook.Application")
Set l_Msg = objApp.CreateItem(olMailItem)
' add graphic as attachment to Outlook message
' change path to graphic as needed
Set colAttach = l_Msg.Attachments
Set l_Attach = colAttach.Add("c:\AIAIAI.jpg")
l_Msg.Close olSave
strEntryID = l_Msg.EntryID
Set l_Msg = Nothing
' *** POSITION CRITICAL *** you must dereference the
' attachment objects before changing their properties
' via CDO
Set colAttach = Nothing
Set l_Attach = Nothing
' initialize CDO session
On Error Resume Next
Set oSession = CreateObject("MAPI.Session")
oSession.Logon "", "", False, False
' get the message created earlier
Set oMsg = oSession.GetMessage(strEntryID)
' set properties of the attached graphic that make
' it embedded and give it an ID for use in an <IMG> tag
Set oAttachs = oMsg.Attachments
Set oAttach = oAttachs.Item(1)
Set colFields = oAttach.Fields
Set oField = colFields.Add(CdoPR_ATTACH_MIME_TAG, "image/jpeg")
Set oField = colFields.Add(&H3712001E, "myident")
oMsg.Fields.Add "{0820060000000000C000000000000046}0x8514", 11, True
oMsg.Update
' get the Outlook MailItem again
Set l_Msg = objApp.GetNamespace("MAPI").GetItemFromID(strEntryID)
' add HTML content -- the <IMG> tag
l_Msg.HTMLBody = "<html><p>This is a picture.</p><img src=cid:myident>"
l_Msg.Close (olSave)
l_Msg.Display
' clean up objects
Set oField = Nothing
Set colFields = Nothing
Set oMsg = Nothing
oSession.Logoff
Set oSession = Nothing
Set objApp = Nothing
Set l_Msg = Nothing
End Sub
Display More
Re: Trying to paste a range into Outlook as bitmap image
still same problem
regards, Youtham
Re: Trying to paste a range into Outlook as bitmap image
I'm out of ideas then, sorry.
Oh well one more idea or rather a debug...
run the code and then when the email is created with the red cross right click in the body and pick View Source.
Post the contents of the html body maybe that will help cure your problem.
Re: Trying to paste a range into Outlook as bitmap image
Thanks Dude
:?
Re: Trying to paste a range into Outlook as bitmap image
tried in almost 6 computers
cant find view source in the right click menu of mail body
regards, Youtham
Re: Trying to paste a range into Outlook as bitmap image
Here what mine generated.
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META http-equiv=Content-Type content="text/html; charset=iso-8859-1">
<META content="MSHTML 6.00.2900.2604" name=GENERATOR></HEAD>
<BODY>
<P>This is a picture.</P><IMG src="cid:myident"></BODY></HTML>
you could try emailing the email too me
Re: Trying to paste a range into Outlook as bitmap image
ur mail ID
Re: Trying to paste a range into Outlook as bitmap image
Nice....
I get an attachment. I wonder if using Word as your email editor has an effect or whether it's a setting in outlook doing something with inserts.
Could you try another test with it done manually?
Re: Trying to paste a range into Outlook as bitmap image
Andy
got the source code but not the image
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META http-equiv=Content-Type content="text/html; charset=iso-8859-1">
<META content="MSHTML 6.00.2800.1491" name=GENERATOR></HEAD>
<BODY>
<P>This is a picture.</P><IMG src="cid:myident"></BODY></HTML>
regards, Youtham
Don’t have an account yet? Register yourself now and be a part of our community!