Did you have a look @ the Links ?
Anyway here is a Late Bound Version.....try this....
Sub ChartInEmail_V1()
'// Amendmenst by Ivan F Moala 17th March 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 Xl2003 / 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
'// MAPI
Dim oMsg As Object
Dim oAttachs As Object
Dim oAttach As Object
Dim colFields As Object
Dim oField As Object
Dim ID As Object
Const CdoPR_ATTACH_MIME_TAG = &H370E001E
'Make sure that a chart is selected
If ActiveChart Is Nothing Then
MsgBox "Please select a chart to email"
Exit Sub
End If
'Get the temp folder path
Set oFSObj = CreateObject("Scripting.FilesystemObject")
strTempFilePath = oFSObj.GetSpecialFolder(2)
strTempFilePath = strTempFilePath & "\MyChart.gif"
'Export the chart. We'll use it later
With ActiveChart
.Export strTempFilePath, "GIF"
.ChartArea.Copy
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)
oOutlookMessage.Close olSave
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] )
'Value
'::Required (optional in first syntax). Variant.
'::The value of the field, of the data type specified in the Class
':
arameter or implicit in the PropTag parameter. You can change the
'::value later by setting it directly or by subsequent calls to the
Field object's ReadFromFile method.
'PropsetID
'::Optional. String. Contains the GUID that identifies the property
set,
'::represented as a string of hexadecimal characters.
'::When this identifier is not present, the property is created
'::within the default property set. The default property set is
'::either the property set most recently supplied to the
'::SetNamespace method, or the initial default property set value,
PS_PUBLIC_STRINGS.
'PropTag
'::Required. Long. The MAPI property tag for a predefined MAPI
property.
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 = "<b>This is the chart you were looking
for.</b><br><br><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
' clean up objects
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
