Exchangeユーザの所属・役職・上司などの情報を取得するマクロ

投稿者:

珍しくプログラミングネタ。会社でOutlookやLync(Skype for Business)を使用しているならば、同じ会社のユーザ情報が取得できると思いますが、それをExcelなどのマクロから取得する方法です。

Exchangeユーザをメールアドレスから特定する方法が他のブログではあまり書かれていない(というか検索して無理やり取り出しているので会社規模がでかいとすごく時間がかかる)ですが、Recipientオブジェクトを使用する方法が一番シンプルだと思います。

Sub getExchangeUserFromAddress()
    Dim oNS As Outlook.Namespace
    Dim recResolve As Recipient
    Dim objExchUser As ExchangeUser
    
    Set oNS = GetNamespace("MAPI")
    
    'Recipientオブジェクトを作る
    Set recResolve = oNS.CreateRecipient("hoge@hoge.com")
    '名前解決する(必須ではないがやっておいた方が良い)
    recResolve.Resolve
    'アドレスエントリからExchangeUserを取得する
    Set objExchUser = recResolve.addressEntry.GetExchangeUser
    
    If Not objExchUser Is Nothing Then
        '名前を取得
        Cells(1, 1) = objExchUser.Name
        '役職名を取得
        Cells(1, 2) = objExchUser.JobTitle
        '部署名
        Cells(1, 3) = objExchUser.Department
        '上司
        Cells(1, 4) = objExchUser.GetExchangeUserManager.Name
    End If
End Sub

 

返信を残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

CAPTCHA