Sub ChartInEmail_V1()

'// Original by DK

'// 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 / 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

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





'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] )

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



End Sub