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
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
cOutlookAddressBook
' 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
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.
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
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