ExcelからExchangeの配布リストのメンバーのデータを再帰的に取得する #Excel

Excelで簡単な部署内電話帳みたいなものが作成したくて以下のような感じでスクリプトを組んでみました。
すごーく動作が遅いですが、当方の環境がOutlookの住所録に10万件以上登録されているような環境だからかもしれないし、そのわりにインフラが絶望的に酷いからかもしれません。
しかし、根本的に裏方の仕組みを考えれば当然遅いのは自明の理なので、使用してみる際にはサーバへの負荷等を考慮して試してみてください。

環境

Excel 2010
Outlook 2010
※Excel VBA上にて、参照設定でOutlookを追加してください

コード - code

ほしい情報をユーザ定義型でまとめます。

Option Explicit

Private Type tdata
    Dept As String      '組織
    Jt As String        '役職
    Name As String
    Inline As String    '内線
    Tel As String       '外線
    Mobile As String
End Type

一部Exchangeのデータ外のものが含まれていますが、こちらのExchange登録情報の問題です。

Public Sub getdata()

    ' https://msdn.microsoft.com/ja-jp/library/office/bb645998.aspx

    ' グローバルな Outlook の Application および NameSpace 変数を宣言します。
    ' namespace("MAPI")とsessionは同じらしい
    Dim objSession          As Object
    Dim glbAdressList       As Outlook.AddressList
    Dim oAEs              As Outlook.AddressEntries
    Dim oAE                 As Outlook.AddressEntry
    Dim i As Long, j As Integer
    Dim data() As tdata

    Set objSession = CreateObject("Outlook.Application").Session
    Set glbAdressList = objSession.GetGlobalAddressList
    Set oAEs = glbAdressList.AddressEntries
    Set oAE = oAEs("配布リスト")

    ReDim Preserve data(0) '仮で0になるはず

    Debug.Print Time
    Call DLexpand(oAE, data)
    Debug.Print Time

    For i = 1 To UBound(data)
        Debug.Print data(i).Name
    Next i

End Sub

グローバルアドレス帳からほしい配布リストを指定します。
動的配列は例によってVBAでは検知できないので今回は0番目は空と決め打ちします。

以下が再帰関数です。配布リストの中に配布リストがある度に呼び出されます。

Private Sub DLexpand(oAE As Outlook.AddressEntry, data() As tdata)

    Dim oExUser As Outlook.ExchangeUser
    Dim oAEs As Outlook.AddressEntries
    Dim oEDL As Outlook.ExchangeDistributionList
    Dim i As Integer
    Dim tmp As Variant

    Set oEDL = oAE.GetExchangeDistributionList
    Set oAEs = oEDL.GetExchangeDistributionListMembers

    For i = 1 To oAEs.Count
        Set oAE = oAEs(i)
        If oAE.DisplayType = olUser Then
            Set oExUser = oAE.GetExchangeUser
            ReDim Preserve data(UBound(data) + 1)
            With data(UBound(data))
                .Dept = oExUser.Department
                .Jt = oExUser.JobTitle
                tmp = Split(oExUser.Name, "(")
                .Name = tmp(0)
                .Mobile = oExUser.MobileTelephoneNumber
                If InStr(oExUser.BusinessTelephoneNumber, "/") Then
                    tmp = Split(oExUser.BusinessTelephoneNumber, "/")
                    .Inline = tmp(0)
                    .Tel = tmp(1)
                ElseIf oExUser.BusinessTelephoneNumber <> "" Then
                    .Tel = oExUser.BusinessTelephoneNumber
                    .Inline = ""
                End If
            End With
        'addressentry dysplaytypeがolRemoteUserがいるので省く
        ElseIf oAE.DisplayType = olDistList Then
            Call DLexpand(oAE, data)
        End If
    Next

End Sub

ユーザ定義型に代入してるところはそれぞれの環境に合わせてください。

その他

Excelだとマクロの記録とかがあって参考になるけど、今回はガッツリとOutlookのヘルプを見て考えました。より楽な方法とか高速な方法があれば教えていただければ助かります。

2017/3/3 少しコードを更新しました。想定外のユーザがいたため、Elseifではじきます。