More VSTO fun : WindowActivate in Outlook/Word 2007 does not fire for Wordmail more than once

Welcome to the horrible world of creating Outlook addins that work for both 2003 and 2007.

People have commented that wordmail has a horrible side effect in Word 2003, where toolbars used in Outlook inspectors show up in Word.  See the this Kevin Slovak’s discussion of the problem in the links section.

Anyway, the workaround mentioned in the article doesn’t work (of course) in Outlook 2007.  It is therefore necessary to check the version of Word (which doesn’t have toolbars) for the code to work for both versions.

It makes me wish Microsoft would hand out free office upgrades.

Anyway, here’s the complete code:

 

' Listen for inspector activate
Private WithEvents moWord As Microsoft.Office.Interop.Word.Application
Private moInspector As Inspector
Private Sub moWord_WindowActivate(ByVal Doc As Microsoft.Office.Interop.Word.Document, ByVal Wn As Microsoft.Office.Interop.Word.Window) Handles moWord.WindowActivate

     If Wn.EnvelopeVisible AndAlso moInspector IsNot Nothing Then
         mShowInspector(moInspector)
         moInspector = Nothing
         moWord = Nothing
         If Doc.AttachedTemplate IsNot Nothing Then Doc.AttachedTemplate.Saved = True
     End If

End Sub
Private Sub moInspectors_NewInspector(ByVal Inspector As Microsoft.Office.Interop.Outlook.Inspector) Handles moInspectors.NewInspector

     Dim lbRaiseEvents As Boolean = True

     If Inspector.IsWordMail Then
         ' HACK: Wordmail does not work in the same way in
         ' Word 2008 as it does in 2003.  I think this
         ' may be because of the lack of real toolbars
         ' in Word 2007.
         If Val(Inspector.WordEditor.Application.Version) < 12 Then
             moInspector = Inspector
             moWord = Inspector.WordEditor.Application
             lbRaiseEvents = False
         End If
     End If
     If lbRaiseEvents Then mShowInspector(Inspector)

End Sub

 

This code is provided in case some poor soul out there gets the problem as well. 

 

Links

Problem with Inspector CommandBars and MS Word [WiredBox.Net - Office Newsgroups]

Inspector Wrapper for Wordmail VSTO and vb.net

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 :

Twittering from Outlook Using VBA

Recently I toyed with the idea of letting my boss know what tasks I completed in a day in the hope he actually believes I’m doing something.  I thought of sending constant emails or keeping a diary.    Something briefer was would be more useful.

This got me thinking about services such as Twitter.  Perhaps it has a purpose after all.

I do keep track of tasks in Outlook using the “Getting Things Done” method (I’ll post on this another time) using macros.  I thought I’d see how easy it was to report status updates to twitter.  As it turns out, very easy!

The following simple code sample can be reused to send messages to Twitter:

Sub PromptForTwitterPost()
    Dim lsInput As String
    lsInput = InputBox("Type in text of twitter Post", "Twitter", "")
    If lsInput = "" Then Exit Sub
    PostToTwitter lsInput
End Sub
Sub PostToTwitter(statusUpdate As String)
    PostToTwitterWithAuth statusUpdate, "someuserid", "somepassword"
End Sub
Sub PostToTwitterWithAuth(statusUpdate As String, username As String, password As String)

     Dim WinHttpReq As New WinHttpRequest
     ' Assemble an HTTP Request.
    WinHttpReq.Open "POST", _
      "http://twitter.com/statuses/update.xml?status=" & statusUpdate, False
    WinHttpReq.SetCredentials "yyyyyyyyy", "xxxxxxxxx", HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
    ' Send the HTTP Request.
    WinHttpReq.Send
End Sub

 

This example will work with any Office VBA or VB6 language. 

You can use this macro to use task items to get the status text:

 

Sub ReportTaskAsComplete()

   ' Extract task title
   For Each loItem In Outlook.Application.ActiveExplorer.Selection
    If TypeOf loItem Is TaskItem Then
         Dim loTask As TaskItem
         Set loTask = loItem
         loTask.Status = olTaskComplete
         loTask.Save
  
         PostToTwitter Task.Subject & " - Complete"
    End If
   Next

End Sub

 

Links

• If you want a deluxe solution for Twittering in Outlook, try Outwit

VSTO Outlook Add-in Debug errors even for simple HelloWorld add-in

Recently I have been developing an Outlook addin utilising a Model View Controller Architecture and Mocks.

This architecture has given me a great deal of testability of my addin without having to run Outlook.  The downside of this of course is that today when I went to run the Outlook Addin for real it didn’t work.

I pressed “run”, Outlook started, then the IDE went out of debug.  No breakpoints hit, no errors, no nothing.  Great!

The False Solution

As it turns out the “Windows Live Toolbar” (whose indexing I use all the time in Outlook) uses .net Framework 1.1.  It internally forces Outlook addins to use 1.1, which means my 2.0 addin failed to work.  Not fun.

I uninstalled the Windows Live Toolbar and now I can debug successfully.

I guess this highlights the fact that you still need to do testing of the real application as well as.

The post that helped me work out the problem is here:

VSTO Outlook Add-in Debug errors even for simple HelloWorld add-in – MSDN Forums

The Real Solution – An update to the original post

This is happening again!  I’d re-uninstall the Windows Live toolbar if I could but it’s not there anymore!

As it turns out that somehow my addin had become “disabled”.  Apparently if one addin is “disabled”, all will be disabled.  Re – Enabling Addins (or un-disabling) has to be done from the highly intuitive location of the Outlook checkbox.

The steps I took.

1. Go into Help->About and click on the “Disabled Items…” button.  Reenable the addin.

2. Go into Tools->Options->Other->Advanced Options->Com Addins.  Remove the Addin

3. Quit outlook, then check task manager and ensure “OUTLOOK.EXE” is not running.  If it is, “End Process” it.

4. You should now be able to debug addins again.