Can I do queries against the local address book in Outlook?

Question

I am running the below code and making a lot of hits on the Microsoft Exchange server.

This often causes this particular code to crash for one reason or another. I get a variety of inconsistent VBA errors at runtime or even a complete crash of outlook as a result. The .GetDirectReports method seems unstable in my experience when being called frequently.

I am wondering if I can run the following code against the cached/local version of the Outlook Address book. I see "Updating Address book" in Outlook often so I know somewhere there is a saved address book.

Can I interface with this saved address book somehow rather than pinging the Exchange server?

---

Public Sub printAllReports()

    Dim allReports As Collection
    Set allReports = New Collection

    Dim curLevelReports As Collection
    Set curLevelReports = New Collection

    Dim nextLevelReports As Collection
    Set nextLevelReports = New Collection

    Dim myTopLevelReport As ExchangeUser
    Set myTopLevelReport = getExchangeUserFromString("name to resolve")

    'add to both the next level of reports as well as all reports
    allReports.Add myTopLevelReport
    curLevelReports.Add myTopLevelReport

    Dim tempAddressEntries As AddressEntries
    Dim newExUser As ExchangeUser
    Dim i, j As Integer

    'flag for when another sublevel is found
    Dim keepLooping As Boolean
    keepLooping = False

    'this is where the fun begins
    Do

        'get current reports for the current level
        For i = curLevelReports.Count To 1 Step -1
            'get all the reports for this person
            Set tempAddressEntries = curLevelReports.Item(i).GetDirectReports

            'add all reports (note .Count returns 0 on an empty collection)
            For j = 1 To tempAddressEntries.Count
                Set newExUser = tempAddressEntries.Item(j).getExchangeUser

                'with no email or title they probably aren't real? this function checks that
                If (isExchangeUserActualEmployee(newExUser) = True) Then
                    allReports.Add newExUser
                    nextLevelReports.Add newExUser
                    keepLooping = True
                End If

            Next j
            Set tempAddressEntries = Nothing


        Next i

        'reset for next iteration
        Set curLevelReports = nextLevelReports
        Set nextLevelReports = New Collection

        'no more levels to keep going
        If keepLooping = False Then
            Exit Do
        End If

        'reset flag for next iteration
        keepLooping = False

    Loop

    Dim oMail As Outlook.MailItem
    Set oMail = Application.CreateItem(olMailItem)


    'do stuff with this information (currently just write to new email, could do other cool stuff)
    For i = 1 To allReports.Count
        oMail.Body = oMail.Body + allReports.Item(i).name + ";" + allReports.Item(i).JobTitle
        'Debug.Print getFirstName(allReports.item(i).name) & " " & getLastName(allReports.item(i).name)
        'oMail.Body = oMail.Body + allReports.Item(i).FirstName & " " & allReports.Item(i).LastName & ";" & allReports.Item(i).JobTitle & ";" & allReports.Item(i).Alias & vbCrLf
        'Debug.Print allReports.Item(i).PrimarySmtpAddress

    Next i

    oMail.Display

End Sub

Answer 1

This allows you to access the local address lists.

Unfortunately, each entry has very minimal information. You can however get significant information from Exchange based on which entries are associated into what address books (you can get a list of all contacts, email lists, etc, depending I suppose on who Exchange is configured.

Sub useLocalAddressLists()

    Dim mContact As AddressList
    Dim mAddressBook As AddressLists

    Set mAddressBook = Application.GetNamespace("MAPI").AddressLists

    For Each mContact In mAddressBook
        Debug.Print mContact.name & vbTab & mContact.AddressEntries.Count

        If mContact.name = "Global Address List" Then
            For j = 1 To mContact.AddressEntries.Count
                'do stuff
            Next j


        End If
    Next mContact

End Sub