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ではじきます。