0

以下のコードを実行しており、Microsoft Exchange サーバーで多くのヒットを記録しています。

これにより、この特定のコードが何らかの理由でクラッシュすることがよくあります。実行時にさまざまな一貫性のない VBA エラーが発生したり、結果として Outlook が完全にクラッシュしたりすることさえあります。私の.GetDirectReports経験では、頻繁に呼び出されるとメソッドが不安定に見えます。

Outlook アドレス帳のキャッシュ/ローカル バージョンに対して次のコードを実行できるかどうか疑問に思っています。Outlook で「アドレス帳の更新」が頻繁に表示されるので、どこかにアドレス帳が保存されていることを知っています。

Exchange サーバーに ping を実行するのではなく、この保存されたアドレス帳に何らかの方法で接続できますか?

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
4

2 に答える 2

0

これにより、ローカル アドレス リストにアクセスできます。

残念ながら、各エントリには最小限の情報しかありません。ただし、どのエントリがどのアドレス帳に関連付けられているかに基づいて、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
于 2013-09-06T15:16:19.960 に答える
0

いいえ、アドレス帳データをキャッシュするかどうかを選択することはできません。正確なエラーは何ですか？

于 2013-06-26T15:12:37.070 に答える