This is an old question, I thought the solution I was using worked, but it isn't, I currently have a couple of functions that try to retrieve recipients email address, which is as follows:
If entry.Type = "EX" Then
' Outlook 2010
If (Solution_Outlook.addinmodule.currentinstance.HostMajorVersion >= 14) Then
'Recipientrow.Email = Solution_Outlook.addinmodule.currentinstance.fnGetRecipientExchangeAddress(myEmail, entry.Address)
Recipientrow.Email = Solution_Outlook.addinmodule.currentinstance.GetSMTPAddressViaOutlookObjectModel(entry)
Else
Recipientrow.Email = Solution_Outlook.addinmodule.currentinstance.fnGetOutlook2007ExchangeAddress(entry.Address)
End If
Else
Recipientrow.Email = myEmail.Recipients.Item(i).Address
End If
#Region "Get SMTP Address via Object Model"
Public Function GetSMTPAddressViaOutlookObjectModel(ByVal entry As Object) As String
If Not (entry Is Nothing) Then
Dim user As Object = entry.GetType().InvokeMember("GetExchangeUser", System.Reflection.BindingFlags.InvokeMethod, Nothing, entry, New Object() {})
If Not (user Is Nothing) Then
Try
Return user.GetType().InvokeMember("PrimarySmtpAddress", System.Reflection.BindingFlags.GetProperty, Nothing, user, New Object() {}).ToString()
Finally
Marshal.ReleaseComObject(user)
End Try
End If
End If
Return String.Empty
End Function
#End Region
#Region "Get Outlook 2007 Exchange Address"
Public Function fnGetOutlook2007ExchangeAddress(ByVal myEmailAddress As String) As String
Try
Dim currentItem As Object = Nothing
Dim ns As Outlook._NameSpace = Nothing
Dim sessionPtr As IntPtr = IntPtr.Zero
' Dim inspector As Outlook._Inspector = Nothing
Dim addrBook As IntPtr = IntPtr.Zero
Try
If myEmailAddress IsNot Nothing Then
If myEmailAddress IsNot Nothing Then
Dim entryAddress = myEmailAddress
If MAPI.MAPIInitialize(IntPtr.Zero) = MAPI.S_OK Then
MAPI.MAPILogonEx(0, Nothing, Nothing, MAPI.MAPI_EXTENDED Or MAPI.MAPI_ALLOW_OTHERS, sessionPtr)
If sessionPtr = IntPtr.Zero Then
MAPI.MAPILogonEx(0, Nothing, Nothing, MAPI.MAPI_EXTENDED Or MAPI.MAPI_NEW_SESSION Or MAPI.MAPI_USE_DEFAULT, sessionPtr)
End If
If sessionPtr <> IntPtr.Zero Then
Dim sessionObj As Object = Nothing
Try
sessionObj = Marshal.GetObjectForIUnknown(sessionPtr)
Dim session As IMAPISession = TryCast(sessionObj, IMAPISession)
If session IsNot Nothing Then
session.OpenAddressBook(0, IntPtr.Zero, MAPI.AB_NO_DIALOG, addrBook)
If addrBook <> IntPtr.Zero Then
fnGetOutlook2007ExchangeAddress = GetOuttlook2007SMTPAddress(entryAddress, addrBook)
Return fnGetOutlook2007ExchangeAddress
End If
End If
Finally
If sessionObj IsNot Nothing Then
Marshal.ReleaseComObject(sessionObj)
End If
End Try
End If
End If
End If
Else
Throw New ApplicationException("MAPI can not be initialized.")
End If
Finally
If sessionPtr <> IntPtr.Zero Then
Marshal.Release(sessionPtr)
End If
If addrBook <> IntPtr.Zero Then
Marshal.Release(addrBook)
End If
If ns IsNot Nothing Then
Marshal.ReleaseComObject(ns)
End If
If currentItem IsNot Nothing Then
Marshal.ReleaseComObject(currentItem)
End If
'If inspector IsNot Nothing Then
' Marshal.ReleaseComObject(inspector)
'End If
End Try
Catch err As Exception
'MessageBox.Show(err.Message, err.Source, MessageBoxButtons.OK, MessageBoxIcon.[Error])
End Try
Return Nothing
End Function
#End Region
Region "Get Outlook 2007 SMTP Address"
Private Function GetOuttlook2007SMTPAddress(address As String, addrBookPtr As IntPtr) As String
Dim addrBookObj As Object = Nothing
Dim smtpAddress As String = [String].Empty
Try
addrBookObj = Marshal.GetObjectForIUnknown(addrBookPtr)
Dim addrBook As IAddrBook = TryCast(addrBookObj, IAddrBook)
If addrBook IsNot Nothing Then
Dim szPtr As IntPtr = IntPtr.Zero
Dim propValuePtr As IntPtr = Marshal.AllocHGlobal(16)
Dim adrListPtr As IntPtr = Marshal.AllocHGlobal(16)
Marshal.WriteInt32(propValuePtr, CInt(MAPI.PR_DISPLAY_NAME))
Marshal.WriteInt32(New IntPtr(propValuePtr.ToInt32() + 4), 0)
szPtr = Marshal.StringToHGlobalAnsi(address)
Marshal.WriteInt64(New IntPtr(propValuePtr.ToInt32() + 8), szPtr.ToInt32())
Marshal.WriteInt32(adrListPtr, 1)
Marshal.WriteInt32(New IntPtr(adrListPtr.ToInt32() + 4), 0)
Marshal.WriteInt32(New IntPtr(adrListPtr.ToInt32() + 8), 1)
Marshal.WriteInt32(New IntPtr(adrListPtr.ToInt32() + 12), propValuePtr.ToInt32())
Try
If addrBook.ResolveName(0, MAPI.MAPI_DIALOG, Nothing, adrListPtr) = MAPI.S_OK Then
Dim spValue As New SPropValue()
Dim pcount As Integer = Marshal.ReadInt32(New IntPtr(adrListPtr.ToInt32() + 8))
Dim props As New IntPtr(Marshal.ReadInt32(New IntPtr(adrListPtr.ToInt32() + 12)))
For i As Integer = 0 To pcount - 1
Dim addrEntryPtr As IntPtr = IntPtr.Zero
Dim propAddressPtr As IntPtr = IntPtr.Zero
Try
spValue = DirectCast(Marshal.PtrToStructure(New IntPtr(props.ToInt32() + (16 * i)), GetType(SPropValue)), SPropValue)
If spValue.ulPropTag = MAPI.PR_ENTRYID Then
Dim objType As UInteger = 0
Dim cb As UInteger = CUInt(spValue.Value And &HFFFFFFFFUI)
Dim entryID As New IntPtr(CInt(spValue.Value >> 32))
If addrBook.OpenEntry(cb, entryID, IntPtr.Zero, 0, objType, addrEntryPtr) = MAPI.S_OK Then
If MAPI.HrGetOneProp(addrEntryPtr, MAPI.PR_EMS_AB_PROXY_ADDRESSES, propAddressPtr) = MAPI.S_OK Then
Dim emails As IntPtr = IntPtr.Zero
Dim addrValue As SPropValue = DirectCast(Marshal.PtrToStructure(propAddressPtr, GetType(SPropValue)), SPropValue)
Dim acount As Integer = CInt(addrValue.Value And &HFFFFFFFFUI)
Dim pemails As New IntPtr(CInt(addrValue.Value >> 32))
For j As Integer = 0 To acount - 1
emails = New IntPtr(Marshal.ReadInt32(New IntPtr(pemails.ToInt32() + (4 * j))))
smtpAddress = Marshal.PtrToStringAnsi(emails)
If smtpAddress.IndexOf("SMTP:") = 0 Then
smtpAddress = smtpAddress.Substring(5, smtpAddress.Length - 5)
Exit For
End If
Next
End If
End If
End If
Catch
Finally
If propAddressPtr <> IntPtr.Zero Then
Marshal.Release(propAddressPtr)
End If
If addrEntryPtr <> IntPtr.Zero Then
Marshal.Release(addrEntryPtr)
End If
End Try
Next
End If
Finally
If szPtr <> IntPtr.Zero Then
Marshal.FreeHGlobal(szPtr)
End If
If propValuePtr <> IntPtr.Zero Then
Marshal.FreeHGlobal(propValuePtr)
End If
If adrListPtr <> IntPtr.Zero Then
Marshal.FreeHGlobal(adrListPtr)
End If
End Try
End If
Finally
If addrBookObj IsNot Nothing Then
Marshal.ReleaseComObject(addrBookObj)
End If
If addrBookPtr <> IntPtr.Zero Then
Marshal.Release(addrBookPtr)
End If
End Try
Return smtpAddress
End Function
#End Region
Is this method correct, is seems I sometimes get blank entries in my Recipients table. |