Getting the SMTP Email Address of an Exchange Sender of a MailItem from Outlook in VB.NET VSTO

 

Sometimes the easiest things in software development are the hardest things.  Particularly when it comes to VSTO development.

The Problem

You’d think that programmatically retrieving the sender’s SMTP email address from an email item in Outlook would be easy wouldn’t you?  It isn’t.

The “Address” property of the MailItem object is supposed to return the email address.   And it does if your email comes from an internet sender, such as a friendly Nigerian businessman.  If the email sender a user of Microsoft Exchange, you get a wierd X400 formatted email address.  Not very handy if you want the SMTP email address.

If you search for this information you’ll find solutions that usually involve obsolete components (CDO 1.21 – Unsupported by Microsoft) or 3rd party dlls (such as the excellent “Outlook Redemption”).   See the links section at the bottom of this article for a list of the good articles that discuss these techniques.

If you want your application to “remain pure” .NET however, there is no “cut and dried” solution.

The Solution

After much experimentation and agony my colleague Puji Arsana and myself have devised a solution that uses pure VSTO and VB.Net, without any 3rd party dependencies.

It seems to me that many people have already created this solution (and published parts of this), but so far noone has published a complete solution before.

So without further ado, here’s the VB.NET code to allow you to extract the SMTP email address, regardless of whether it’s an exchange or internet email.

Private Function GetSMTPEmailAddress(mailItem As MailItem) As String

    If mailItem.SenderAddressType = "EX" Then
         Return GetEmailAddressForExchangeServer(loItem.Name)
    Else
         Return mailItem.Address
    End If

End Function

Private Function GetEmailAddressForExchangeServer(ByVal emailName As String) As String
        Dim loDummyMsg As MailItem = moMailItem.Application.CreateItem(OlItemType.olMailItem)
        Dim loAddress As Recipient = loDummyMsg.Recipients.Add(emailName)

        loAddress.Resolve()
        Dim lsSmtpAddress As String = GetMAPIProperty(loAddress.AddressEntry.MAPIOBJECT, PR_SMTP_ADDRESS)
        Return lsSmtpAddress

End Function

#Region "MAPI Interface ID'S"
    ' The Interface ID's are used to retrieve the specific MAPI Interfaces from the IUnknown Object
    Private Const IID_IMAPISession As String = "00020300-0000-0000-C000-000000000046"
    Private Const IID_IMAPIProp As String = "00020303-0000-0000-C000-000000000046"
    Private Const IID_IMAPITable As String = "00020301-0000-0000-C000-000000000046"
    Private Const IID_IMAPIMsgStore As String = "00020306-0000-0000-C000-000000000046"
    Private Const IID_IMAPIFolder As String = "0002030C-0000-0000-C000-000000000046"
    Private Const IID_IMAPISpoolerService As String = "0002031E-0000-0000-C000-000000000046"
    Private Const IID_IMAPIStatus As String = "0002031E-0000-0000-C000-000000000046"
    Private Const IID_IMessage As String = "00020307-0000-0000-C000-000000000046"
    Private Const IID_IAddrBook As String = "00020309-0000-0000-C000-000000000046"
    Private Const IID_IProfSect As String = "00020304-0000-0000-C000-000000000046"
    Private Const IID_IMAPIContainer As String = "0002030B-0000-0000-C000-000000000046"
    Private Const IID_IABContainer As String = "0002030D-0000-0000-C000-000000000046"
    Private Const IID_IMsgServiceAdmin As String = "0002031D-0000-0000-C000-000000000046"
    Private Const IID_IProfAdmin As String = "0002031C-0000-0000-C000-000000000046"
    Private Const IID_IMailUser As String = "0002030A-0000-0000-C000-000000000046"
    Private Const IID_IDistList As String = "0002030E-0000-0000-C000-000000000046"
    Private Const IID_IAttachment As String = "00020308-0000-0000-C000-000000000046"
    Private Const IID_IMAPIControl As String = "0002031B-0000-0000-C000-000000000046"
    Private Const IID_IMAPILogonRemote As String = "00020346-0000-0000-C000-000000000046"
    Private Const IID_IMAPIForm As String = "00020327-0000-0000-C000-000000000046"
#End Region

#Region "MAPI Properties"

    ' MAPI Properties
    Public Const PR_TRANSPORT_MESSAGE_HEADERS As UInteger = 8192030
    Public Const PR_BODY As UInteger = 268435486
    Public Const PR_BODY_HTML As UInteger = 269680670
    Public Const PR_HTML As UInteger = 269680898
    Public Const PR_DISPLAY_NAME As UInteger = 805371934
    Public Const PR_SUBJECT As UInteger = 3604510
    Public Const PR_EMAIL_ADDRESS As UInteger = 805503006
    'public const uint PR_NEG_EMAIL_ADDRESS = -2146496482;
    Public Const PR_SMTP_ADDRESS As UInteger = 972947486
    Public Const PR_ADDRTYPE As UInteger = 805437470
#End Region

#Region "structure and variables "
    Private Structure SPropValue
        Public ulPropTag As UInteger
        Public dwAlignPad As UInteger
        Public Value As Long
    End Structure

    ' return codes
    Private Const S_OK As Integer = 0
#End Region

#Region "MAPI Functions"

    <DllImport("MAPI32.DLL", CharSet:=CharSet.Ansi, EntryPoint:="HrGetOneProp@12")> _
    Private Shared Sub HrGetOneProp(ByVal pmp As IntPtr, ByVal ulPropTag As UInteger, ByRef ppProp As IntPtr)
    End Sub

    <DllImport("MAPI32.DLL", CharSet:=CharSet.Ansi, EntryPoint:="HrSetOneProp@8")> _
    Private Shared Sub HrSetOneProp(ByVal pmp As IntPtr, ByVal pprop As IntPtr)
    End Sub

    <DllImport("MAPI32.DLL", CharSet:=CharSet.Ansi, EntryPoint:="MAPIFreeBuffer@4")> _
    Private Shared Sub MAPIFreeBuffer(ByVal lpBuffer As IntPtr)
    End Sub

    <DllImport("MAPI32.DLL", CharSet:=CharSet.Ansi)> _
    Private Shared Function MAPIInitialize(ByVal lpMapiInit As IntPtr) As Integer
    End Function

    <DllImport("MAPI32.DLL", CharSet:=CharSet.Ansi)> _
    Private Shared Sub MAPIUninitialize()
    End Sub

    ''' <summary>
    ''' Get a property from a passed MAPI object
    ''' </summary>
    ''' <param name="oMAPIObject"></param>
    ''' <param name="uiPropertyTag"></param>
    ''' <returns></returns>
    Private Shared Function GetMAPIProperty(ByVal oMAPIObject As Object, ByVal uiPropertyTag As UInteger) As String

        If oMAPIObject.Equals(Nothing) Then
            'No MAPI Object
            Return ""
        End If

        Dim sProperty As String = ""
        Dim pPropValue As IntPtr = IntPtr.Zero

        Dim IUnknown As IntPtr = IntPtr.Zero
        Dim IMAPIProperty As IntPtr = IntPtr.Zero

        Try

            ' initialize MAPI
            MAPIInitialize(IntPtr.Zero)

            ' get the unknown object.
            IUnknown = Marshal.GetIUnknownForObject(oMAPIObject)

            'get the property
            Dim guidIMAPIProp As New Guid(IID_IMAPIProp)
            If Marshal.QueryInterface(IUnknown, guidIMAPIProp, IMAPIProperty) <> S_OK Then
                'Failed to get IMAPIProperty
                Return ""
            End If

            Try

                ' get the field from the MAPI Property
                HrGetOneProp(IMAPIProperty, uiPropertyTag, pPropValue)
                ' Is the property actually there?
                If pPropValue = IntPtr.Zero Then
                    Return ""
                End If
                ' Get the value back
                Dim propValue As SPropValue = DirectCast(Marshal.PtrToStructure(pPropValue, GetType(SPropValue)), SPropValue)
                ' convert to string

                sProperty = Marshal.PtrToStringAnsi(New IntPtr(propValue.Value))
            Catch ex As System.Exception
                Throw ex
            End Try
        Finally
            ' CLEAN UP
            If pPropValue <> IntPtr.Zero Then
                MAPIFreeBuffer(pPropValue)
            End If

            If IMAPIProperty <> IntPtr.Zero Then
                Marshal.Release(IMAPIProperty)
            End If
            If IUnknown <> IntPtr.Zero Then
                Marshal.Release(IUnknown)
            End If

            MAPIUninitialize()
        End Try

        Return sProperty
    End Function
#End Region

How it Works

If the email is from exchange it translates the  email address into a “Recipient” object. 

Recipient objects expose “AddressEntry” objects, which in turn can be utilised by “ExtendedMAPI”.

The code then uses ExtendedMAPI which can “see” the property where the normal Outlook API cant.

Links

See http://www.outlookcode.com/d/code/getsenderaddy.htm#redemption and http://www.cdolive.com/cdo5.htm#EMailAddressOfSender for Redemption and CDO examples and http://groups.google.com/group/microsoft.public.outlook.program_vba/browse_frm/thread/4d4d5fece24a2a7/ad2fcbb691d5bf18 for a discussion of the property to use with Cached Exchange Mode in Outlook 2003 or later.

Share this post :

---

Possibly related posts: (automatically generated)

• Catching Application Level Mouse Events in Winforms
• Silverlight 3 style NavigationContext in WPF
• Disabling the context menu in the .Net CF WebBrowser Control