SEND PHOTO

verluc · Dec 25, 2003

Is it possible to mail a photo from excel?
I have a photo in a sheet and want this to send via e-mail.?
Many thanks for a tip

Smitty · Dec 25, 2003

If you're using Outlook, check out Ron DeBruin's suggestions.

http://www.rondebruin.nl/sendmail.htm

Specifically this:

'You can add other files also like this
'.Attachments.Add ("C:\test.txt")

If you're using a different e-mail client, posty back with what you're using.

Hope that helps.

Smitty

verluc · Dec 25, 2003

Thanks Pennysaver,but I want this to do without an attachments,because most people don't like attachments.The body of my mail must be the photo

Many thanks

Ivan F Moala · Dec 25, 2003

Hi Verluc

here is some code adapted from my page here;

http://www.xcelfiles.com/Outlook_Chart.html

<pre>Option Explicit

'To create an HTML message that included an embedded image -- that, instead,
'all "" <img> "" tags had to use full URLs to public web addresses.
'The impossible has become possible, though, through the efforts of Outlook MVP Neo,
'who devised a method that uses undocumented MAPI properties and CDO.

'CDO = Microsoft® Collaboration Data Objects
'CDO does not represent a new messaging model, but rather an additional scripting interface
'to the Messaging Application Programming Interface (MAPI) model.

'for more info see;
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/cdo/html/_olemsg_overview_of_cdo.asp

'For versions see;
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dncdsys/html/cdo_roadmap.asp

'In VBA or Visual Basic you will need to add a reference to the CDO 1.21 library to use this procedure.
'For client applications, you should install Outlook in order to install CDO.
'In Outlook 2000 and Outlook 2002, CDO is included, but you must explicitly select
'it during setup.

'Microsoft CDO 1.21 Library
'MAPI
'GUID = {3FA7DEA7-6438-101B-ACC1-00AA00423326}
'Path C:\PROGRA~1\COMMON~1\System\Mapi\1033\NT\CDO.DLL
'GUID Ref .AddFromGuid "{3FA7DEA7-6438-101B-ACC1-00AA00423326}",1,21
'.Item("MAPI")

Sub InsertPictureInEmail_V1()
'// Ivan F Moala 17th March 2003
'// Amendment
'// Ivan F Moala 30th June 2003
'// Thanks to Outlook MVP Neo
'// Original used "<img src=" image full address
'// So the image had to have a url web address to
'// be viewed properly
'// Testing under Xl2000 / WinXP

'// Dimension variables, lets use Latebinding
Dim oOutlookApp As Object
Dim oOutlookMessage As Object
Dim oFSObj As Object
Dim strHTMLBody As String
Dim strTempFilePath As String
Dim oOutlookAppAttach As Object
Dim oOutlook_Att As Object
Dim strEntryID As String
Dim oSession As Object

'// Use Early binding = Reference CDO
Dim oMsg As MAPI.Message
Dim oAttachs As MAPI.Attachments
Dim oAttach As MAPI.Attachment
Dim colFields As MAPI.Fields
Dim oField As MAPI.Field
Dim ID As Object
Dim objPict As Shape
Dim MyChart As Chart
Dim Pict As Shape
Dim blnPict As Boolean

'// You need to run this in the Sheet that has the Image!
For Each Pict In ActiveSheet.Shapes
If Pict.Type = 13 Then
If MsgBox("Email this Picture:= " & Pict.Name & vbCr & _
"Use this ? ", vbYesNo) = vbYes Then
Set objPict = ActiveSheet.Shapes(Pict.Name)
blnPict = True
Exit For
End If
End If
Next

'// Make sure that an Image is set
If Not blnPict Then
MsgBox "No Picture selected!"
Exit Sub
End If

'//
'Get the temp folder path
Set oFSObj = CreateObject("Scripting.FilesystemObject")

strTempFilePath = oFSObj.GetSpecialFolder(2)
strTempFilePath = strTempFilePath & "\MyImg.gif"

With objPict
.CopyPicture 1, 2
Set MyChart = ActiveSheet.ChartObjects.Add(1, 1, .Width + 8, .Height + 8).Chart
End With

'// Export the chart. We'll use it later
With MyChart
.Paste
.Export strTempFilePath
.Parent.Delete
End With

'//
'Create an instance of Outlook (or use existing instance if it already exists
Set oOutlookApp = CreateObject("Outlook.Application")

'Create a mail item
Set oOutlookMessage = oOutlookApp.CreateItem(0)
Set oOutlookAppAttach = oOutlookMessage.Attachments
' add graphic as attachment to Outlook message
' change path to graphic as needed
Set oOutlook_Att = oOutlookAppAttach.Add(strTempFilePath)

'// Lets save the msg, this is so that the EntryID property
'// is set.
oOutlookMessage.Close olSave

'// Lets get the unique entry ID of the object.
'// EntryID property corresponds to the MAPI property PR_ENTRYID.
'// MAPI systems assign a permanent, unique ID string when an object
'// is created that does not change from one MAPI session to another.
'// Also, the EntryID changes when an item is moved into another folder.
strEntryID = oOutlookMessage.EntryID

Set oOutlookMessage = Nothing
' *** POSITION CRITICAL *** you must dereference the
' attachment objects before changing their properties
' via CDO
Set oOutlookAppAttach = 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 = oFieldsColl.Add (name, Class [, value] [, PropsetID] )
Set oField = colFields.Add(CdoPR_ATTACH_MIME_TAG, "image/gif")
Set oField = colFields.Add(&H3712001E, "MyIdent")

oMsg.Fields.Add "{0820060000000000C000000000000046}0x8514", 11, True
oMsg.Update

'// Here put any HTML you want - this is just an example
strHTMLBody = "This is the Image you were looking for.
"
strHTMLBody = strHTMLBody & "Get back to me ASAP
"
strHTMLBody = strHTMLBody & "Looking forward to your reply.

"
strHTMLBody = strHTMLBody & "Ivan F Moala

<hr>"

' get the Outlook MailItem again
Set oOutlookMessage = oOutlookApp.GetNamespace("MAPI").GetItemFromID(strEntryID)

' add HTML content -- the <IMG> tag
With oOutlookMessage
.HTMLBody = strHTMLBody & "<IMG align=baseline border=0 hspace=0 SRC=cid:MyIdent>"
.Close (olSave)
.Display
End With

'// cleanup
Set oFSObj = Nothing
Set oField = Nothing
Set colFields = Nothing
Set oMsg = Nothing
Set oAttachs = Nothing
Set oAttach = Nothing
Set colFields = Nothing

oSession.Logoff

Set oSession = Nothing
Set oOutlookApp = Nothing
Set oOutlookMessage = Nothing

Kill strTempFilePath

End Sub</pre>

Ivan F Moala · Dec 25, 2003

Code Tags Not Displayed properly...If you want an Example I can Emial you one........

verluc · Dec 26, 2003

Hi Ivan,

I use now the macro from Daniel Klann:sending a range of a sheet.That range of a sheet is my photo,but when sending it,I get not the picture but a X in the left uppercorner of my mail.(in the body of my mail)
How can I get the picture?
Many thanks

Ivan F Moala · Dec 26, 2003

Easier if I send an example....

verluc · Dec 26, 2003

Ivan,I send you a P.M. with my mail adress.
Thanks in advance

SEND PHOTO

verluc

Well-known Member

Excel Facts

Smitty

Legend

verluc

Well-known Member

Ivan F Moala

MrExcel MVP

Ivan F Moala

MrExcel MVP

verluc

Well-known Member

Ivan F Moala

MrExcel MVP

verluc

Well-known Member

Similar threads

Forum statistics

Share this page

SEND PHOTO

Well-known Member

Excel Facts

Legend

Well-known Member

MrExcel MVP

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock