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
Function GetOutlookApp() As Object
Set GetOutlookApp = CreateObject("Outlook.Application")
End Function
Function GetNS(ByRef app As Object) As Object
Set GetNS = app.GetNamespace("MAPI")
End Function
Function GetItems(olNS As Object, folder As Long) As Object
Set GetItems = olNS.GetDefaultFolder(folder).Items
End Function
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
Function GetOutlookApp() As Object
Set GetOutlookApp = CreateObject("Outlook.Application")
End Function
Function GetNS(ByRef app As Object) As Object
Set GetNS = app.GetNamespace("MAPI")
End Function
Function GetItems(olNS As Object, folder As Long) As Object
Set GetItems = olNS.GetDefaultFolder(folder).Items
End Function
About JP
7 Comments:
I have reasonably extensive experience with VBA in most Office Applications except Outlook but would very much like to be able to load/update, contact details of a large number of contacts maintained in an Access Database. My ultimate purpose is to have them available in a separate (to my main contacts list) Group so that I can view them this way on my iPhone after synchronisation.
Getting them into a spreadsheet is a routine procedure that is performed monthly anyway, so I am lkooking a something similar to what this code offers but with a little more and actually transferring the data to Outlook. Each update could involve additions, deletions and changes so it may be easiest to delete the group and rebuild it each month.
Can anyone help?
Let me conclude by saying that I find this site most educational.
This would help you import contacts into Outlook from Excel:
http://www.jpsoftwaretech.com/blog/2009/01/create-outlook-contacts-in-bulk-using-vba-automation/
But the code would need to be enhanced to put each contact into a category, look for existing contacts and update them, delete expired ones, etc, or as you suggested, delete the entire category and rebuild the list (which I do here: http://www.jpsoftwaretech.com/blog/2010/06/automatically-update-outlook-distribution-lists-from-excel/)
I am not a developer but just a guy with some funky ideas. I am creating a email alert system that will notify users of the status of their requested items. Since multiple users are assigned to these items, I need an easy fool-proof way for the user to select names besides their own and have the email address be attached to the requested item for a status alert update.I would like to lookup five names and return the email addresses in the adjacent cell for each of the five people. This will only be a lookup from the GAL as this makes the most sense as no user keeps co-workers info in there address book. I would like to match the display names input (Name,Fame) in columns e, g, i, k, m in rows 10-31 from the excel sheet to the GAL and return the SMTP address in the adjacent cells. If you could provide me guidance, I would really appreciate this.
If nobody keeps co-worker info in the local Address book, then you don't need SMTP addresses. Just address the email to the user's name, and call the MailItem.Recipients.ResolveAll Method, and Outlook will figure out where to send it.
Instead of searching the contacts folder by name (like below) is there way to search the same by e-mail ID or any other unique details similar to e-mail ID for e.g. Alias?
Set contact = contacts.Item(contactName)
When too many names are similar e.g. Pete this search always refers to the first most instance. Whereas if i could able to search by e-mail ID then i could retrieve an accurate search result.
Appreciate your help!
Hi and thanks to guys like you who take the time to help guys like me! I am using the above code and it works well but I have a need to retrieve Contact details from a folder other than the default Contacts folder. I have a folder named "Temp" sitiing under "My Contacts". Would the solution also work for a Contact list set up as a Public Folder?
Thanks in anticipation – Steve
Instead of using the default Contacts folder, you would need to walk the hierarchy like this:
Set contacts = Session.GetDefaultFolder(olFolderContacts).Folders("Temp")To get a public folder, you would need to use the olPublicFoldersAllPublicFolders enumeration, same as above.