Category Archives: Outlook

Updating Twitter via SuperTweet using VBA

Standard

image

In my previous article I showed how to update a twitter status, prior to the twitter decision to remove the basic authentication api.  This article shows a way of getting around this.  The SuperTweet service allows you to continue to use basic authentication.  This is particularly useful for non-visual processes that use VBA.

I am currently using Twitter to update a private tweet-stream of my activities (such as sending email) from an Outlook 2010 macro.  This stream is then fed into the iPhone application Momento, which provides me with an “autodiary” based on my various twitter feeds and online services.

To use the SuperTweet, there are just three steps:

  1. Sign In with OAuth to the SuperTweet.net  (Sign-Up/Sign-In Now)
  2. Create a password for your applications to use with the SuperTweet.net API when they want to Tweet: Learn more.
  3. Change your application to use http://api.supertweet.net instead of Twitter.com.  See the sample below on how to do this using WinHttp in VBA. ( Learn more.)

The VBA code below will allow you to do an update to Twitter.  The UrlEncode implementation came from this StackOverflow post.

Function PostToTwitter(statusUpdate As String, username As String, password As String) As Boolean
    Const HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = 0 
    On Error GoTo error_handler
   
    Dim WinHttpReq As New WinHttpRequest
 
     ' Assemble an HTTP Request.
    WinHttpReq.Open "POST", _
      "http://api.supertweet.net/1/statuses/update.xml", False
    WinHttpReq.SetCredentials username, password, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
    ' Send the HTTP Request.
    WinHttpReq.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    WinHttpReq.Send "status=" & URLEncode(statusUpdate)
    If WinHttpReq.Status <> 200 Then
      
       GoTo error_handler
    End If
    DoEvents
    Debug.Print "Posted - " & statusUpdate
   
    PostToTwitter = True
   
    Exit Function

error_handler:

    PostToTwitter = False
   
    Exit Function
       
End Function

Public Function URLEncode( _
   StringToEncode As String, _
   Optional UsePlusRatherThanHexForSpace As Boolean = False _
) As String

  Dim TempAns As String
  Dim CurChr As Integer
  CurChr = 1

  Do Until CurChr - 1 = Len(StringToEncode)
    Select Case Asc(Mid(StringToEncode, CurChr, 1))
      Case 48 To 57, 65 To 90, 97 To 122
        TempAns = TempAns & Mid(StringToEncode, CurChr, 1)
      Case 32
        If UsePlusRatherThanHexForSpace = True Then
          TempAns = TempAns & "+"
        Else
          TempAns = TempAns & "%" & Hex(32)
        End If
      Case Else
        TempAns = TempAns & "%" & _
          Right("0" & Hex(Asc(Mid(StringToEncode, _
          CurChr, 1))), 2)
    End Select

    CurChr = CurChr + 1
  Loop

  URLEncode = TempAns
End Function

Advertisements

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

Standard

image

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

Standard

 image

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 :