SMTP Address

Add-in Express™ Support Service
That's what is more important than anything else

SMTP Address
 
SSL




Posts: 171
Joined: 2014-01-05
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.
Posted 25 Feb, 2018 13:42:37 Top
Andrei Smolin


Add-in Express team


Posts: 14809
Joined: 2006-05-11
Hello Tom,

Do you have an email(s)/recipient(s) on which the issue is reproducible?

Regards from Belarus (GMT+3),

Andrei Smolin
Add-in Express Team Leader
Posted 26 Feb, 2018 04:35:40 Top
SSL




Posts: 171
Joined: 2014-01-05
It varies, I was never 100% convinced that the functions above worked, as I was given so many examples of how to obtain an smtp address properly relating to outlook 2007 upto current version at the time
Posted 05 Mar, 2018 12:16:11 Top
Andrei Smolin


Add-in Express team


Posts: 14809
Joined: 2006-05-11
Hello Tom,

You should reproduce the issue and debug the code to find out the root cause. If you have an email with such a recipient, we can debug the code ourselves.

Regards from Belarus (GMT+3),

Andrei Smolin
Add-in Express Team Leader
Posted 06 Mar, 2018 07:47:21 Top
Andrei Smolin


Add-in Express team


Posts: 14809
Joined: 2006-05-11
Hello Tom,

Thank you for forwarding those emails to me. I've found out that the projects we published at https://www.add-in-express.com/creating-addins-blog/2009/05/08/outlook-exchange-email-address-smtp/ handle the receipients correctly. Does the VB.NET project from that blog work for you?

Regards from Belarus (GMT+3),

Andrei Smolin
Add-in Express Team Leader
Posted 09 Mar, 2018 08:48:30 Top