Excel 2007: Format of email address from Outlook 2007

Question

I have a list of first and last names in Excel and I want to utilize that list to look up email address in Outlook using visual basic.

I'm using the following VB code:

    Private Sub GetAddresses()
    Dim o, AddressList, AddressEntry
    Dim c As Range, r As Range, AddressName As String
    Set o = CreateObject("Outlook.Application")
    Set AddressList = o.Session.AddressLists("Global Address List")
    Set r = Range("a1:a3")
    For Each c In r
        AddressName = Trim(c.Value) & ", " & Trim(c.Offset(0, 1).Value)
        For Each AddressEntry In AddressList.AddressEntries
            If AddressEntry.Name = AddressName Then
                c.Offset(0, 2).Value = AddressEntry.Address
                Exit For
            End If
        Next AddressEntry
    Next c
    End Sub

The code seems to be working fine up until the point of actually retrieving the email address. After it matches a name its returning the following instead of the address. Does anyone have an idea of what I'm doing wrong.

/O=Compnay/OU=Company/cn=Recipients/cn=shs

Thanks in advance for you help.

can you please show a sample of your data - frist name, last name ? — userAZLogicApps

Sorceri Sorceri · Accepted Answer · 2012-12-11T17:37:47

I am assuming that these are domain users. You want to get the SMTP address from the exchangeUser object. I have updated your code to show this.

Private Sub GetAddresses()
    Dim o, AddressList, AddressEntry
    Dim c As Range, r As Range, AddressName As String
    'added variable for exchange user object
    Dim exchangeUser As Outlook.exchangeUser

    Set o = CreateObject("Outlook.Application")
    Set AddressList = o.Session.AddressLists("Global Address List")
    Set r = Range("a1:a3")
    For Each c In r
        AddressName = Trim(c.Value) ' & ", " & Trim(c.Offset(0, 1).Value)
        For Each AddressEntry In AddressList.AddressEntries
            If AddressEntry.Name = AddressName Then
            'set the exchange user object
            Set exchangeUser = AddressEntry.GetExchangeUser
            'get the smtp addresss
            c.Offset(0, 2).Value = exchangeUser.PrimarySmtpAddress
            'release
            Set exchangeUser = Nothing
                Exit For
            End If
        Next AddressEntry
    Next c
End Sub

Excel 2007: Format of email address from Outlook 2007

2 Answers