Global Address Book Visualisation (Part I)

Ever wanted to mine the entire global address book and then present it as an interactive visualisation?

Me too!

First off, we need the data. The following VBA code can be run in Outlook to iterate through the whole address book and pull the data. The key fields here are really the alias and the manager - that's how we're going to build our hierarchy.

Click permalink below to see more

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub tgr()

    Dim appOL As Object
    Dim oGAL As Object
    Dim oContact As Object
    Dim oMgr As Object
    Dim oUser As Object
    Dim i As Long
    Dim entryString As String

    Set appOL = Application
    Set oGAL = appOL.GetNamespace("MAPI").AddressLists("Global Address List").AddressEntries

    Open "C:\GAL_Bit.csv" For Append As #1
    
    Debug.Print ("starting")
    Debug.Print (Now())
    
    MsgBox (oGAL.Count)
    
    For i = 1 To oGAL.Count
        entryString = ""
        
        Set oContact = oGAL.Item(i)
        If oContact.AddressEntryUserType = 0 Then
            Sleep (100)
            Set oUser = oContact.GetExchangeUser
            
            If Not oUser Is Nothing Then
                entryString = """" & oUser.Alias & """|""" & oUser.FirstName & """|""" & oUser.LastName & """|""" & oUser.City & """|""" & oUser.Department & """|""" & oUser.OfficeLocation & """|""" & oUser.JobTitle & """|""" & oUser.BusinessTelephoneNumber & """|""" & oUser.MobileTelephoneNumber & """|""" & oUser.PrimarySmtpAddress & """|"""
                           
                Set oManager = oUser.GetExchangeUserManager
                If Not oManager Is Nothing Then
                    entryString = entryString & oManager.Alias & """"
                Else
                    entryString = entryString & """"
                End If
                
                Print #1, entryString
            End If
            
        End If
    Next i
    
   Close #1
    
    Debug.Print ("finished")
    Debug.Print (Now())
    
    Set appOL = Nothing
    Set oGAL = Nothing
    Set oContact = Nothing
    Set oUser = Nothing
 '   Erase arrUsers

End Sub

Sub example()
Sleep (500)

End Sub

The next part will be building the visualisation backend!