How to get data into Excel from your outlook address book get it now
Here’s a common problem. You have a list of email addresses in Excel and you want to pick up various pieces of data from your contacts or global address list, matched on the email address. This is going to cover how to do that in a generalized way. This project grew out of something entirely different though. I needed to create a visualization of locations of groups of people in my Outlook global address list. It occurred to me that since I could do that directly from excel using another project General Google visualization tool, if i could just get the data from Outlook to Excel the problem would be solved. As usual there is a fully functional example in downloads section.
Approach
Lets assume that we have a table with various column headings. One of the columns is going to contain the ‘key’. I mean by that the unique item that is going to be used to find the contact information for each row in the table, for example the email address or the alias or some other outlook field. An initial sheet will look like this, in this case using the alias field as the key field to match on – and we want to populate the other fields from our exchange global address list.
Getting the data
As in a number of other examples on this site we are going to use Data Manipulation Classes to read the data and abstract it from it’s physical location. Note that changes are only made to the sheet at the very end, and are not committed if there was a problem. Using this abstraction therefore makes rollback easy, and also avoids messing around with application.screenupdating.
Creating a class to access outlook
We always try to reuse code on this site, so we are going to create a useful class to connect Excel to Outlook, that can be used in future projects.In this case we will create 2 new classes, cOutlookAddressBook (to perform the lookup and populate a cDataSet with matched data from the Outlook address book) and cOutlookApp (to kick off an outlook session). The code for these is below
cOutlookApp
<pre>Option Explicit
Private pWasClosed As Boolean
Private pOutlookApp As Outlook.Application
Private pDirty As Boolean
Public Property Get OutlookApp() As Outlook.Application
Set OutlookApp = pOutlookApp
End Property
Public Function Init() As Boolean
Set pOutlookApp = GetObject(, "Outlook.Application")
'if it wasnt already running, create one
pWasClosed = pOutlookApp Is Nothing
If pWasClosed Then
Set pOutlookApp = New Outlook.Application
End If
Init = True
End Function
Public Sub Destroy()
Set pOutlookApp = Nothing
End Sub</pre>
cOutlookAddressBook
<pre>' class to retrieve data from outlook address book given an email address
Option Explicit
Private pWasClosed As Boolean
Private pAddressBook As Outlook.AddressList
Private pOutlookApp As cOutlookApp
Private pDirty As Boolean
Public Property Get AddressBook() As Outlook.AddressList
Set AddressBook = pAddressBook
End Property
Public Function Init(oa As cOutlookApp, sBook As String) As Boolean
Set pOutlookApp = oa
' open the requested address book
Set pAddressBook = pOutlookApp.OutlookApp.Session.AddressLists(sBook)
Init = True
End Function
Public Sub Destroy()
'nothing to do
End Sub
Public Function Populate(ds As cDataSet, target As String) As Boolean
Dim e As Outlook.AddressEntry, ex As Outlook.ExchangeUser, sh As String
Dim sl As String, dr As cDataRow, dc As cCell, sa As String, ltoGo As Long
' this is the target key
sl = LCase(target)
ltoGo = ds.RowCount
' clear out any existing data, except for key
For Each dr In ds.Rows
dr.CustomField = False
For Each dc In ds.Headings
If LCase(dc.toString) <> sl Then
dr.Cell(dc.Column).Value = vbNullString
End If
Next dc
Next dr
' since it takes a while to retrieve exchaneguser, we'll make that outer loop
For Each e In pAddressBook.AddressEntries
If ltoGo <= 0 Then Exit For ' if all done lets leave
Set ex = e.getExchangeUser
If Not ex Is Nothing Then
sa = LCase(getValue(e, ex, sl)) ' the key for this record
For Each dr In ds.Rows
If Not dr.CustomField Then ' used to determine whether we've been here already
If sa = LCase(dr.Cell(sl).toString) Then
' we have a match- we're using the custom field to track completion
dr.CustomField = True
ltoGo = ltoGo - 1
' need to fill in the lookup fields
For Each dc In ds.Headings
sh = LCase(dc.toString)
' not the key
If sh <> sl Then
dr.Cell(dc.Column).Value = getValue(e, ex, sh)
If pDirty Then Exit Function
End If
Next dc
End If
End If
Next dr
End If
Next e
Populate = True
End Function
Private Function getValue(e As Outlook.AddressEntry, ex As Outlook.ExchangeUser, colName As String) As String
getValue = vbNullString
Select Case colName
Case "alias"
getValue = ex.Alias
Case "firstname"
getValue = ex.FirstName
Case "lastname"
getValue = ex.LastName
Case "officelocation"
getValue = ex.OfficeLocation
Case "stateorprovince"
getValue = ex.StateOrProvince
Case "streetaddress"
getValue = ex.StreetAddress
Case "department"
getValue = ex.Department
Case "email"
getValue = ex.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001E")
Case "country"
getValue = e.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3a26001e")
Case Else
MsgBox (colName & " data not implemented")
pDirty = True
End Select
End Function</pre>
Implemented fields
To get a field filled in from outlook just create a column with the name of the field. You will see from the code above it is pretty straightforward to add additional Outlook fields if they are not yet implemented in the example. Note that use is made of the exchangeUser object as well as the propertyAccessormethod. In outlook the details about an exchange user are scattered all over the place, and it’s hard to find a definitive place where everything is documented. Abstracting where these fields are into this custom class is going to simplify everything, for now and for future Outlook type applications. Note that these objects require at least excel 2007. Note that your column headings should exactly match the case statements in the getValue function, whose purpose is to abstract their Outlook Object model location away from the column data required.
The application procedure
Now that all the classes are completed all the remains is to create your application. Here is the example one provided in Downloads. It is expecting to execute on the active sheet, and the function, getLikelyColumnRange will assume that everything on the sheet is subject to lookup. You would also probably amend od.Populate(ds, "alias") to identify which is they key field you want to use for lookup.
<pre>Option Explicit
Const sBook = "Global Address List"
Public Sub getOutLookData()
Dim od As cOutlookAddressbook
Dim oa As cOutlookApp
Dim rData As Range, dSets As cDataSets, ds As cDataSet
' kick off an outlook session
Set oa = New cOutlookApp
If oa.Init Then
' get the required addresslist
Set od = New cOutlookAddressbook
If od.Init(oa, sBook) Then
' you could replace this with a dialogue to get the range to be processed
Set rData = getLikelyColumnRange
'create a cdataset of that range
Set dSets = New cDataSets
With dSets
.Create
.Init rData, , "data"
End With
Set ds = dSets.DataSet("data")
' now populate - will only actually commit to the sheet if all was well
' using the alias field/column as the key
If od.Populate(ds, "alias") Then
ds.Commit
End If
od.Destroy
Else
MsgBox ("Couldnt open address book " & sBook)
End If
' clear up
oa.Destroy
Set od = Nothing
Set oa = Nothing
Else
MsgBox ("Couldnt start outlook")
End If
End Sub</pre>
That’s it folks
That’s all there is to it. Now you have a skeleton to add more fields or put a form in front of to allow all sorts of data to be brought in from Outlook.
In the meantime why not join our forum, follow the blog or follow me on Twitter to ensure you get updates when they are available. Although this is not really an Outlook specific site there are a few other Outlook examples, such as A tagCloud in Outlook