See my reply in the outlook.program_vba newsgroup.
Please do not multipost.
Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
"gopi" <gopi[ at ]discussions.microsoft.com> wrote in message
news:45DC2EFA-1E0A-48E9-811F-7F942BBB029E[ at ]microsoft.com...
[Quoted Text] > Environment:
> -Outlook 2002(XP)
> -Added references to "Microsoft Outlook 10.0 Object Library" & "Microsoft
> CDO 1.21 Library"
>
> I have written a VB project using MS Visual Basic 6.0. My intention is to
> add a X-Header to a mail that is being sent from
>
> Outlook. I am capturing the ItemSend event and trying to add the header in
> that event handler.
>
> Please find the complete source code below. Please note that the Sub
> ChangeHeader() is working fine if I call it for
>
> an existing mail in my Outlook Inbox. But I have a problem in calling this
> ChangeHeader() from my ItemSend event handler, as
>
> ChangeHeader() takes MAPI.Message as an argument, but MyOLApp_ItemSend()
> is
> giving me Outlook.MailItem.
>
> How do I convert Outlook.MailItem to MAPI.Message?
> Or
> Is there any other way to add the X-header without needing to have a
> MAPI.Message object?
>
>
> Thanks,
> Gopi
>
> ************************************************************************
>
>
> Public WithEvents MyOLApp As Outlook.Application
>
> Sub Intialize_Event_Handlers()
>
> Set MyOLApp = Application
> MsgBox "Initialize Event Handlers successful"
>
> End Sub
>
>
>
> Private Sub Command1_Click()
>
> Intialize_Event_Handlers
>
> End Sub
>
>
>
> Private Sub MyOLApp_ItemSend(ByVal Item As Object, Cancel As Boolean)
>
> MsgBox "I am in ItemSend handler"
>
> Dim myMailItem As Outlook.MailItem
> Set myMailItem = Item
>
> MsgBox myMailItem.Subject
>
> 'How do I now call ChangeHeader(), which takes MAPI.Message, as an
> argument!!!
> 'Add the custom header now
> 'ChangeHeader oMessage
>
>
> End Sub
>
>
>
> Sub ChangeHeader(oMessage As MAPI.Message)
>
> ' Initalize error handling
> On Error Resume Next
>
> MsgBox "ChangeHeader - BEGIN", vbInformation
>
> Dim oFields As MAPI.Fields
> Set oFields = oMessage.Fields
>
> Dim strheader As String
>
> ' Get SMTP header
> Err.Clear
> strheader = oFields.Item(CdoPR_TRANSPORT_MESSAGE_HEADERS).Value
>
> If Err.Number = 0 Then
> MsgBox strheader 'Display the original Internet headers
>
> 'Append the custom X-Header now!
> oMessage.Fields(CdoPR_TRANSPORT_MESSAGE_HEADERS) =
> oMessage.Fields(CdoPR_TRANSPORT_MESSAGE_HEADERS) & vbCrLf &
>
> "X-MY-HEADER9: Hello"
>
> ElseIf Err.Number = &H8004010F Then
> Err.Clear
> MsgBox "No SMTP message header information on this message",
> vbInformation
>
> 'Add the custom X-Header now
> oFields.Add CdoPR_TRANSPORT_MESSAGE_HEADERS, "X-MY-NEWHEADER:
> Hello"
>
> Else
> MsgBox "some vague scenario", vbInformation
>
> End If
>
>
> oMessage.Update
>
> MsgBox "ChangeHeader - END", vbInformation
>
> End Sub
>
>
> ************************************************************************
|