Opening Outlook address book from Excel

Question

I'm using VBA in Excel 2010, with Outlook 2010 (already open).

How could I write a sub such that:

1 Outlook address book opens;
2 The user selects a contact and clicks ok;
3 The contact's first name, last name and email address are stored in cells of the active worksheet?

I tried with this method without success: SelectNamesDialog Object

Also I'm not sure if I need to use: Application.GetNamespace("MAPI")

Answer 1

You are on the right avenue, the SelectNamesDialog is exactly what you are looking for. The GetNamepsace method equals to the Session property used in the sample code:

 Sub ShowContactsInDialog()
  Dim oDialog As SelectNamesDialog
  Dim oAL As AddressList
  Dim oContacts As Folder

  Set oDialog = Application.Session.GetSelectNamesDialog
  Set oContacts = _
    Application.Session.GetDefaultFolder(olFolderContacts)

  'Look for the address list that corresponds with the Contacts folder
  For Each oAL In Application.Session.AddressLists
    If oAL.GetContactsFolder = oContacts Then
        Exit For
    End If
  Next
  With oDialog
    'Initialize the dialog box with the address list representing the Contacts folder
    .InitialAddressList = oAL
    .ShowOnlyInitialAddressList = True
    If .Display Then
        'Recipients Resolved
        'Access Recipients using oDialog.Recipients
    End If
  End With
 End Sub

You may find the following articles helpful:

• How to automate Outlook from another program
• Automating Outlook from a Visual Basic Application

Answer 2

Here is how to get all the details from a selected contact in the GAL:

You need to open the Global Address List and not the contacts from the contact folder, and use an Outlook.ExchangeUser object as explained on this page : see last answer from David Zemens.

Private Sub cmdSetProjectMember1_Click()

    Dim olApp As Outlook.Application
    Dim oDialog As SelectNamesDialog
    Dim oGAL As AddressList
    Dim myAddrEntry As AddressEntry
    Dim exchUser As Outlook.ExchangeUser

    Dim AliasName As String
    Dim FirstName As String
    Dim LastName As String
    Dim EmailAddress As String

    Set olApp = GetObject(, "Outlook.Application")
    Set oDialog = olApp.Session.GetSelectNamesDialog
    Set oGAL = olApp.GetNamespace("MAPI").AddressLists("Global Address List")

    With oDialog
        .AllowMultipleSelection = False
        .InitialAddressList = oGAL
        .ShowOnlyInitialAddressList = True
        If .Display Then
            AliasName = oDialog.Recipients.Item(1).Name
            Set myAddrEntry = oGAL.AddressEntries(AliasName)
            Set exchUser = myAddrEntry.GetExchangeUser

            If Not exchUser Is Nothing Then
                FirstName = exchUser.FirstName
                LastName = exchUser.LastName
                EmailAddress = exchUser.PrimarySmtpAddress
                '...
                MsgBox "You selected contact: " & vbNewLine & _
                    "FirstName: " & FirstName & vbNewLine & _
                    "LastName:" & LastName & vbNewLine & _
                    "EmailAddress: " & EmailAddress
            End If
        End If
    End With
Set olApp = Nothing
Set oDialog = Nothing
Set oGAL = Nothing
Set myAddrEntry = Nothing
Set exchUser = Nothing
End Sub