GetContact returning wrong contact's data

[EAhrens]

I have cobbled together some code designed to allow the user to choose a specific person from their Outlook contacts and return selected info for that contact in cells for use in the workbook. It always returns a different person's info than the one chosen in the GetSelectNamesDialog box. It is somewhat random but typically a close by contact alphabetically. I had co-workers try it and they get the same results. I have tried anything and everything that I could find without any different result. Running Office 365. Thank you.

Sub OutlookContactSummary()

    Dim outApp As Outlook.Application
    Dim outDialog As SelectNamesDialog
    Dim myAddrList As AddressList
    Dim myAddrEntry As AddressEntry
    Dim AliasName As String
    
    Set outApp = GetObject(, "Outlook.Application")
    Set outDialog = outApp.Session.GetSelectNamesDialog
    Set myAddrList = outApp.GetNamespace("MAPI").AddressLists("Contacts")

    With outDialog
        .AllowMultipleSelection = False
        .InitialAddressList = myAddrList
        .ShowOnlyInitialAddressList = True
        If .Display Then
            AliasName = outDialog.Recipients.Item(1).Name
            Set myAddrEntry = myAddrList.AddressEntries(AliasName)
            Range("F3").Value = myAddrEntry.GetContact.FirstName
            Range("G3").Value = myAddrEntry.GetContact.LastName
            Range("M3").Value = myAddrEntry.GetContact.Email1Address
            Range("H3").Value = myAddrEntry.GetContact.CompanyName
            Range("I3").Value = myAddrEntry.GetContact.BusinessAddressStreet
            Range("J3").Value = myAddrEntry.GetContact.BusinessAddressCity
            Range("K3").Value = myAddrEntry.GetContact.BusinessAddressState
            Range("L3").Value = myAddrEntry.GetContact.BusinessAddressPostalCode
        End If
    End With
    
    Set outApp = Nothing
    Set outDialog = Nothing
    Set myAddrList = Nothing
    Set myAddrEntry = Nothing

End Sub

 

[smozgur]

Instead of this:

AliasName = outDialog.Recipients.Item(1).Name
Set myAddrEntry = myAddrList.AddressEntries(AliasName)

Try GetAddressEntryFromID function with the selected item's EntryID.

Set myAddrEntry = outApp.Session.GetAddressEntryFromID(outDialog.Recipients.Item(1).EntryID)

 

[EAhrens]

Instead of this:


Try GetAddressEntryFromID function with the selected item's EntryID.

Set myAddrEntry = outApp.Session.GetAddressEntryFromID(outDialog.Recipients.Item(1).EntryID)

That was the ticket. Works great. Thank you so much! I don't know how many hours I wasted trying to make this work.

 

[smozgur]

That was the ticket. Works great. Thank you so much! I don't know how many hours I wasted trying to make this work.

It is not a waste at all. We all know how it works now

Glad to hear it helps!