【Outlook VBA】Microsoft365のユーザー情報を取得する！

この記事でわかること！

Outlook VBAでMicrofost365 のテナントユーザの連絡先の個人情報を取得する方法
Outlook VBAでMicrofost365 のテナントユーザの連絡先の個人情報を取得する方法（複数アカウントがOutlookに登録されている場合）

VBAでMicrofost 365 テナントのメンバーのアドレスを取得したい

Microfost365に参加したパソコン環境の場合、「Offline Global Address List」というアドレス帳（アドレスリスト）にテナント（組織）に参加する全メンバーのアドレスが含まれているようです。

このOffline Global Address Listは、そのテナントに参加しているユーザーであれば自分のローカルデスクトップにインストールされたOutlookアプリケーションに、クラウドから自動で読み込まれるみたいです。パソコンを買い替えるときにエクスポート・インポートする必要がない連絡帳ですので便利ですね。

今回はこのOffline Global Address Listに登録されたユーザーのメールアドレスや個人情報を、Outlook VBAから読み込み多いと思いましたのでやってみます。

最初に書いたコード（失敗）

まずはメールアドレスを取得してみたくて以下のコードを書きました。結果としてこのコードではメアド取得は失敗です。

STEP

コードを書きます。

'最初に書いたけどNGだったコード
Sub GetUserInfo()
    Dim myNameSpace As NameSpace
    Dim myAddressList As addresslist
    Dim myAddressEntries As AddressEntries
    
    Set myNameSpace = Application.GetNamespace("MAPI")
    Set myAddressList = myNameSpace.AddressLists("Offline Global Address List")
    Set myAddressEntries = myAddressList.AddressEntries
       
    Dim entry As AddressEntry
    For Each entry In myAddressEntries
        Debug.Print (entry.address)
    Next
End Sub

上記のコード内の「Debug.Print (entry.address)」の部分、myAddressList.AddressEntriesにaddressというプロパティがあったので、アドレスを取得するのはこれだろうと思って書いています。

STEP

実行します。

実行してdebugの出力結果をVBEのイミディエイトウィンドウで確認してみるとこんな感じの出力結果が。メールアドレスではなくExchange特有の識別子が出力されました。

この識別子は、X.500という形式のもとに表現されたアドレスを表す文字列で、Exchange環境では一般的なメールアドレスではなくX.500の形式で保持されているようです（Exchange環境ではこのアドレスをLegacyExchangeDNと呼ぶのだとか。）

LegacyExchangeDNの出力例：
/o=ExchangeLabs/ou=Exchange Administrative Group (FYDIBOHF23SPDLT)/cn=Recipients/cn=********************

メールアドレスを取得するにはGetExchangeUserする。

わたしたちが使う一般的な形式のメールアドレスは、AddressEntry.GetExchangeUser メソッドを使ってExchangeUser オブジェクトを取得し、ExchangeUser オブジェクトの.PrimarySmtpAddressプロパティにアクセスすることで取得できます。

公式リファレンス

Exchangeのユーザ情報を取得するコード

STEP

Outlook VBEを開きます。

コードを書くためにエディタ（VBE）を開きます。

はじめてOutlook マクロに触れる方は、必要な初期設定などをまとめた下記の記事も参考になさってください。

あわせて読みたい

【初心者向け】Outlook マクロ（VBA）を使って時短しよう！ Outlook にもExcelと同じようなマクロ機能が存在することをご存じでしょうか。マクロを使えばメールに関する操作を自動化して、時短やミス防止にも役立ちます。この記…

STEP

VBEにコードを書きます。

Sub GetUserInfoFromExchange()
    Dim myNameSpace As NameSpace
    Dim myAddressList As addresslist
    Dim myAddressEntries As AddressEntries
    
    Set myNameSpace = Application.GetNamespace("MAPI")
    Set myAddressList = myNameSpace.AddressLists("Offline Global Address List")
    Set myAddressEntries = myAddressList.AddressEntries
       
    Dim l As AddressEntry
    Dim oExUser As ExchangeUser
    For Each l In myAddressEntries
        Set oExUser = l.GetExchangeUser
        If Not oExUser Is Nothing Then
            Debug.Print ("★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆")
            Debug.Print ("社名：" & oExUser.CompanyName)
            Debug.Print ("部署：" & oExUser.Department)
            Debug.Print ("役職：" & oExUser.JobTitle)
            Debug.Print ("氏名：" & oExUser.Name)
            Debug.Print ("TEL：" & oExUser.BusinessTelephoneNumber)
            Debug.Print ("Mobile：" & oExUser.MobileTelephoneNumber)
            Debug.Print ("郵便番号：" & oExUser.PostalCode)
            Debug.Print ("オフィスロケーション：" & oExUser.OfficeLocation)
            Debug.Print ("Type：" & oExUser.Type)
            Debug.Print ("住所：" & oExUser.StreetAddress)
            Debug.Print ("メールアドレス：" & oExUser.PrimarySmtpAddress)
            Debug.Print ("★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆")
            Debug.Print ("")
            Debug.Print ("")
            Debug.Print ("")
        End If
    Next
End Sub

▲oExUser.PrimarySmtpAddressがメアド取得部分です。せっかくなんでメアド以外にもプロパティがあったので出力してみます。

STEP

コードを実行します。

▲プログラムを実行しイミディエイトウィンドウの出力結果を見てみます。メールアドレスのところに一般的な形式のメールアドレスを取得することができました。そのほかの部署名・役職・氏名・Telなども取得できました。空白になっている箇所（会社名やMobile）はプログラムエラーではなく、Exchangeにデータの登録されていない（空白になっている）からです。空白が気になる場合はMicrofost365管理センターから管理者権限で設定を行ってください。

（※図の中の個人情報は架空人物のサンプルデータです。）

複数のメールアカウント（メールアドレス）がOutlookに登録されている場合の注意点

じょじお

Outlookを1アカウントで使っている場合は上記までで個人情報の取得ができます。

ぽこがみさま

Outlookを複数アカウントで使っている場合はどうしたらいいの？

じょじお

複数アカウントの場合は、アドレス帳を正確に指定する必要があります。

▲複数のメールアカウントがOutlookに登録されている場合、先のコードでは問題が発生する場合があります。

↑の図のようにコード内で指定したOffline Global Address Listが複数存在する可能性があるため、Set myAddressList = myNameSpace.AddressLists("Offline Global Address List")という名前指定でのアドレスリストを取得する場合、最初のひとつだけが取得されてしまうので狙った情報を取得できない可能性があるためです。

ですので、複数のメールアカウントが登録された環境ではアドレスリストのIDを使って下記のように取得する必要があるようです。

Set myAddressList = myNameSpace.AddressLists("アドレスリストのID")

アドレスリスト（AddressList）のIDの取得するコード

STEP

コードを書きます。

アドレスリストのIDを取得するために、下記のコードを書きました。

Sub getAddressLists()
    
    On Error Resume Next
    
    Dim myNameSpace As NameSpace
    Dim myAddressLists As AddressLists
    Set myNameSpace = Application.GetNamespace("MAPI")
    Set myAddressLists = myNameSpace.AddressLists() 'すべてのアドレスリストをGET
    
    Dim al As addresslist
    'すべてのアドレスリストを出力します。
    For Each al In myAddressLists
        Debug.Print ("ID:" & al.Index)
        Debug.Print ("AddressList Name:" & al.Name)
        Debug.Print ("規定:" & al.IsInitialAddressList)
        Debug.Print ("")
    Next
    
    Debug.Print ("---------------------------------------------------")
    
    'グローバルアドレスリストのみを出力します。
    For Each al In myAddressLists
        If al.Name = "Offline Global Address List" Then
        Debug.Print ("ID:" & al.Index)
        Debug.Print ("AddressList Name:" & al.Name)
        Debug.Print ("規定:" & al.IsInitialAddressList)
        Debug.Print ("")
        End If
    Next

End Sub

STEP

アドレスリストのIDを確認します。

---------------------------------------------------
ID:3
AddressList Name:Offline Global Address List
規定:True

ID:11
AddressList Name:Offline Global Address List
規定:False

ID:13
AddressList Name:Offline Global Address List
規定:False

ID:21
AddressList Name:Offline Global Address List
規定:False

コードを実行すると、存在するすべてのアドレスリストと、その下にOffline Global Address Listという名前のアドレスリストがイミディエイトウィンドウに出力されます。

私の環境では上記のようにOffline Global Address Listという名前のアドレスリストは4つあるようです。IDも一緒に出力したので、このIDを使って先ほどのコードにあてはめればOKかなと思います。

STEP

取得したアドレスリストのIDを使ってコードを実行します。

Exchangeのユーザ情報を取得するコード（複数アカウントの場合）

Sub GetUserInfoFromExchange()
    Dim myNameSpace As NameSpace
    Dim myAddressList As addresslist
    Dim myAddressEntries As AddressEntries
    
    Set myNameSpace = Application.GetNamespace("MAPI")

    Set myAddressList = myNameSpace.AddressLists(ここにアドレスリストIDを入力)
'例
'    Set myAddressList = myNameSpace.AddressLists(21)

    Set myAddressEntries = myAddressList.AddressEntries
       
    Dim l As AddressEntry
    Dim oExUser As ExchangeUser
    For Each l In myAddressEntries
        Set oExUser = l.GetExchangeUser
        If Not oExUser Is Nothing Then
            Debug.Print ("★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆")
            Debug.Print ("社名：" & oExUser.CompanyName)
            Debug.Print ("部署：" & oExUser.Department)
            Debug.Print ("役職：" & oExUser.JobTitle)
            Debug.Print ("氏名：" & oExUser.Name)
            Debug.Print ("TEL：" & oExUser.BusinessTelephoneNumber)
            Debug.Print ("Mobile：" & oExUser.MobileTelephoneNumber)
            Debug.Print ("郵便番号：" & oExUser.PostalCode)
            Debug.Print ("オフィスロケーション：" & oExUser.OfficeLocation)
            Debug.Print ("Type：" & oExUser.Type)
            Debug.Print ("住所：" & oExUser.StreetAddress)
            Debug.Print ("メールアドレス：" & oExUser.PrimarySmtpAddress)
            Debug.Print ("★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆")
            Debug.Print ("")
            Debug.Print ("")
            Debug.Print ("")
        End If
    Next
End Sub

上のコードの↓下記の部分にIDの数字を入力します。

Set myAddressList = myNameSpace.AddressLists(ここにアドレスリストIDを入力)

STEP

コードを実行します。

コードを実行します。おわり。

Exchange Userオブジェクトのプロパティ

プロパティ	説明
PrimarySmtpAddress	Eメールアドレス
Address	X400形式のメールアドレス
Alias	エイリアス
LastName	苗字
YomiLastName	苗字よみがな
FirstName	名前
YomiFirstName	名前よみがな
Name	フルネーム（苗字＋名前）
JobTitle	役職名
CompanyName	会社名
YomiCompanyName	会社名よみがな
Department	部署名
YomiDepartment	部署名よみがな
City	市区町村
StreetAddress	番地
PostalCode	郵便番号
OfficeLocation	会社所在地
MobileTelephoneNumber	モバイルTEL番号
BusinessTelephoneNumber	会社TEL番号