IvaSoft

AddXHeader Outlook COM add-in sample application

This example assumes that you have CDO installed.
With Microsoft Outlook 2000/2002 you need to add CDO 1.21 as custom installation option because they are not included in a typical install.

'
Option Explicit
Implements IDTExtensibility2

Dim WithEvents oApp As Outlook.Application
Dim oSession As Object ' CDO MAPI session object

'=========================================================
Private Sub IDTExtensibility2_OnBeginShutdown(custom() As Variant)
'Use this subroutine when the host app is shutting down
'You should persist or destroy your objects in this subroutine
On Error Resume Next
 oSession.Logoff
 Set oSession = Nothing
 Set oApp = Nothing
End Sub

'=========================================================
Private Sub IDTExtensibility2_OnConnection(ByVal Application As Object, _ 
ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _
 ByVal AddInInst As Object, custom() As Variant)
'This subroutine is called when your Add-in is connected to
'by the host application
On Error Resume Next
 Set oApp = Application
 'Create CDO session 
 Set oSession = oApp.CreateObject("MAPI.Session")
 'use existing session
 oSession.Logon 
End Sub

'=========================================================
Private Sub IDTExtensibility2_OnAddInsUpdate(custom() As Variant)
'Use this subroutine when Add-ins are updated
End Sub

'=========================================================
Private Sub IDTExtensibility2_OnDisconnection(ByVal RemoveMode _ 
As AddInDesignerObjects.ext_DisconnectMode, _
custom() As Variant)
'This sub is called when your add-in is disconnected from the host
End Sub

'=========================================================
Private Sub IDTExtensibility2_OnStartupComplete(custom() As Variant)
'This sub is called when the host application has completed
'its startup routines
End Sub

'=========================================================
Private Sub oApp_ItemSend(ByVal Item As Object, _
                          Cancel As Boolean)
 On Error Resume Next
 If TypeName(Item) = "MailItem" Then
   AddXHeader Item, "x-test1", "123456"
   ' cancel ItemSend event
   Cancel = True
 End If
End Sub

'=========================================================
Private Sub AddXHeader(ByVal MailItem As Outlook.MailItem, _
                    Prop As String, Val As String)
 Dim oItem As Object
 Dim oField As Object
 ' Save mail item to get EntryID
 MailItem.Save
 ' Get CDO mail item
 Set oItem = oSession.GetMessage(MailItem.EntryID)
 'Set oField = oItem.Fields.Add(Prop, vbString, Val, _
 '              "0002038600000000C000000000000046")
 'We have to change PropSetID, see MS KB 195656
 '
 Set oField = oItem.Fields.Add(Prop, vbString, Val, _
               "8603020000000000C000000000000046")
 ' Save changes
 oItem.Update
 ' CDO send
 oItem.Send
 ' Cleanup
 Set oField = Nothing
 Set oItem = Nothing

End Sub

As Outlook 2002 includes security features to prevent other programs from accessing your e-mail addresses or sending e-mail messages on your behalf, you will see the security warnings while this add-in is running.

If you are a standalone user, Outlook provides no way to suppress this behavior. However, you can redo the program using Redemption, a third-party COM library that wraps around Extended MAPI.

If you are the administrator in an Exchange Server environment, you can reduce the impact of the security prompts with administrative tools. See Administrative Options for the Outlook E-mail Security Update.

Feel free to send me your comments and criticism.

Thank you,
Victor Ivanidze,
software developer.