vba - 我可以在 Outlook 中对本地通讯簿进行查询吗？

Question

我正在运行下面的代码并在 Microsoft Exchange 服务器上进行了很多点击。

这通常会导致此特定代码由于某种原因而崩溃。我在运行时收到各种不一致的 VBA 错误，甚至导致 Outlook 完全崩溃。根据我的经验，该.GetDirectReports方法在频繁调用时似乎不稳定。

我想知道是否可以针对 Outlook 通讯簿的缓存/本地版本运行以下代码。我经常在 Outlook 中看到“更新通讯录”，所以我知道某处有保存的通讯录。

我能否以某种方式与这个保存的通讯簿进行交互，而不是 ping Exchange 服务器？

---

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

不，您无法选择是否缓存通讯录数据。确切的错误是什么？

Answer 2

这允许您访问本地地址列表。

不幸的是，每个条目的信息非常少。但是，您可以根据哪些条目与哪些地址簿相关联从 Exchange 获取重要信息（您可以获取所有联系人、电子邮件列表等的列表，这取决于我认为谁配置了 Exchange。

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