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 :

Timesnapper – Perfect

 

 

Lately I’ve been coming across some very clever software.  There is certainly some amazing stuff out there.  

I must give pause and thanks to Leon Bambrick in particular for the brilliant program that is “Timesnapper”.

The program takes snapshots at regular intervals of your screen and applications.  It then allow you to “play your day like a movie”. 

There is indeed a “wow” factor to this.  Originally the program was developed to assist contractors in billing their time, as they could “go back” and see what they’d been up to.

The reason for this post is not the “movie” aspect.  (Although this is cool).

The “Pro” version of Timesnapper has the concept of a “Productivity Scorecard” that uses various rules to provide a percentage of how productive you were.  You configure this statistic based on which exes were running and window titles.  This works brilliantly. 

In my day to day work I don’t even think about timesnapper.   It uses minimal resources, it doesn’t “suck”.   Now and then I go in and there’s everything I’ve done, along with the Productivity Scorecard to confirm or deny my memories of the event.

If you use a computer alot and need to manage your time, get it now.

http://www.timesnapper.com

Getting a Screenshot with VB.NET on the Compact Framework 2.0

 

I believe that “thumbnail” images of data in applications is a powerful way of giving an overview to a user.

One sort of application that uses this technique is the “Flip 3D” functionality of Vista.

The code sample below provides a routine that “grabs” a rectangle of the currently displayed screen.  Just like it’s desktop equivalent, it can only take screenshots of the visible screen, not graphics that are off-screen. (Anyone know how to do that? Please let me know!)

Here’s the code:

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    picScreenshot.Image = GetControlBitmap(Me.CreateGraphics, Me.SomeControl.Bounds)
End Sub
Const SRCCOPY As Integer = &HCC0020
Public Declare Function BitBlt Lib "coredll.dll" (ByVal hdc As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As Integer) As Boolean

Private Function GetControlBitmap(ByVal gx As Graphics, ByVal rect As Rectangle) As Bitmap

    ' Create the bitmap to output
    Dim loBitmap As Bitmap = New Bitmap(rect.Width, rect.Height)

    ' Create compatible graphics
    Dim loCompGraphics As Graphics = Graphics.FromImage(loBitmap)

    ' Blit the image data
    BitBlt(loCompGraphics.GetHdc(), 0, 0, rect.Width, rect.Height, gx.GetHdc(), rect.Left, rect.Top, SRCCOPY)

    ' Cleanup
    loCompGraphics.Dispose()
    Return loBitmap
End Function

The function “GetControlBitmap” will get a bitmap of a control or any rectangle passed into it.

Links

• Creating a screen snapshot in CF v2 by Alex Yahnin
• Alex Yakhnin – Excellent CF coding blog. The information here is a goldmine of information that I wish I had a year ago.

Share this post :