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

我可以对Outlook中的本地地址簿进行查询吗？

2 个答案: