Link Excel cells to Outlook data fields

Have you ever wanted to link Excel data to Outlook contacts? Here is a simple event handler that links cells on your Excel worksheet to data fields in Outlook's address book.

We'll use the Worksheet_Change Event to look up contact details for a given name in a cell. This is a "live" link because whenever we change the cell and enter a new name, the event handler fires and looks up the phone number, address and email and returns it to Excel. In this example, it's put into a cell comment, but we'll also show how we can return this information into adjacent cells.

Since the event fires whenever the worksheet is changed, we'll set up Outlook as a module-level variable, so it will be instantiated the first time the event fires and stay open throughout the life of the workbook. That should speed up the operation of the workbook somewhat.

As a bonus, we'll also check the Global Address List (GAL) for contact details, if the name isn't in the local address book!

Dim Outlook As Object
Const olFolderContacts As Long = 10

Private Sub Worksheet_Change(ByVal Target As Range)

Dim contactName As String
Dim contacts As Object
Dim contact As Object
Dim comment As Excel.Comment
Dim contactInfo As String
Dim addressLists As Object  ' Outlook.AddressLists
Dim GAL As Object  ' Outlook.AddressList
Dim addressEntries As Object  ' Outlook.AddressEntries
Dim addressEntry As Object  ' Outlook.AddressEntry

  ' get target cell value ONLY if single cell selected
  If Target.Cells.Count = 1 Then
    contactName = Target.Value
  Else
    Exit Sub
  End If

  ' ignore blanks
  If Len(contactName) = 0 Then
    Exit Sub
  End If

  ' grab Outlook, if not already instantiated previously
  If Outlook Is Nothing Then
    Set Outlook = GetOutlookApp
  End If

  ' get contacts
  Set contacts = GetItems(GetNS(Outlook), olFolderContacts)
  ' try to grab target contact
  On Error Resume Next
  Set contact = contacts.Item(contactName)
  On Error GoTo 0

  ' remove existing comment, if any
  On Error Resume Next
  Set comment = Target.comment
  comment.Delete
  On Error GoTo 0

  If contact Is Nothing Then

    ' try to find in GAL
    Set addressLists = GetNS(Outlook).AddressLists
    Set GAL = addressLists.Item("Global Address List")
    Set addressEntries = GAL.AddressEntries
    On Error Resume Next
    Set addressEntry = addressEntries.Item(Target.Value)
    On Error GoTo 0

    If addressEntry Is Nothing Then
      ' nothing in Contacts Folder or GAL
      contactInfo = "No contact found with this name."
    Else
      ' in GAL but not Contacts Folder
      contactInfo = addressEntry.Name & Chr(10) & addressEntry.Address & Chr(10) & _
                    Chr(10) & "This information came from the Global Address List."
    End If
  Else
    ' in Contacts Folder
    contactInfo = contact.FullName & Chr(10) & contact.BusinessTelephoneNumber _
                & Chr(10) & contact.Department & Chr(10) & _
                  contact.BusinessAddress & Chr(10) & contact.Email1Address
  End If

  ' add comment and put contact info
  Target.AddComment Text:=contactInfo
  Set comment = Target.comment
  comment.Shape.TextFrame.AutoSize = True

End Sub

GetItems, GetNS and GetOutlookApp may be found on the Utility Functions page.

This event should be placed in the Sheet module for the sheet you want to monitor. It checks any changed cell; you probably want to change this behavior to only check the one or two cells you'll put contact names into.

Outlook is instantiated the first time the event fires, but is kept open by the module-level variable so we don't have to keep instantiating it every time the event fires. Of course, if you change the event handler to ONLY fire when certain cells are changed, you can change the Outlook variable scope to local (by moving it into the event handler) since it won't be instantiated as often.

First we try and get the contact from the local Address Book. If the contact does not exist, we check the GAL. Either way, we put the contact details into a comment for the given cell. The contents will vary, and that is reflected in the way the cell is commented.

This technique would work well if you have a sales worksheet with a data validated list of sales or customer service people. As you select each name, that person's contact details are filled in on the worksheet. It's best if you have them set up as Contacts, since more information is available through the ContactItem Object than the AddressEntry Object (using the Outlook Object Model).

Return phone number to adjacent cell

A slight alteration of this function is needed to return specific information to the worksheet. We don't check the GAL anymore, because it only returns name and email address. So the contact name must be in the Address Book for this event handler to be successful.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim contactName As String
Dim contacts As Object
Dim contact As Object
Dim contactInfo As String

  ' get target cell value ONLY if single cell selected
  If Target.Cells.Count = 1 Then
    contactName = Target.Value
  Else
    Exit Sub
  End If

  ' ignore blanks
  If Len(contactName) = 0 Then
    Exit Sub
  End If

  ' grab Outlook, if not already instantiated previously
  If Outlook Is Nothing Then
    Set Outlook = GetOutlookApp
  End If

  ' get contacts
  Set contacts = GetItems(GetNS(Outlook), olFolderContacts)
  ' grab target contact
  On Error Resume Next
  Set contact = contacts.Item(contactName)
  On Error GoTo 0

  If contact Is Nothing Then
    ' nothing in Contacts Folder
    contactInfo = "No contact found with this name."
  Else
    ' in Contacts Folder
    contactInfo = contact.BusinessTelephoneNumber
  End If

  ' put contact info into adjacent cell
  ' turn off Events to avoid event firing again
  Application.EnableEvents = False
    Target.Offset(0, 1).Value = contactInfo
  Application.EnableEvents = True

End Sub

GetItems, GetNS and GetOutlookApp may be found on the Utility Functions page.