Get Data from Outlook


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 inital 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 propertyAccessor method. 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

For more stuff see my book - Going Gas.  All formats are available now from O'Reilly,Amazon and all good bookshops. You can also read a preview on O'Reilly.