メールアドレスからExchangeUserを取得するOutlookマクロ

ホーム
Office関連, Outlook
メールアドレスからExchangeUserを取得するOutlookマクロ

2019.06.18

メールアドレスからExchangeUserを取得するOutlookマクロ

mougに“メールアドレスをキーとしてExchangeグローバルアドレス一覧を検索し、名前や部署名を取得したい”との質問(https://www.moug.net/faq/viewtopic.php?t=78288)がありました。

その回答用に書いたのが以下のコードで、mougのログが流れてしまう前にメモとして残しておきます。

2019/6/19 追記：
いみひと(@nukie_53)さんから返信をいただいてコードを一部変更。
関数名は「By」の方が分かりやすそう！ついでにAddressEntryUserTypeの判定処理も変更。

GetGlobalAddressListの存在を知らなかったので、とりあえず動けばいい、という方法です。
用途として、複数のアドレスからExchangeUserを取得したかったため、作業用のメール作成コストが相対的に低かった、というのもあります。

個人環境なので動作確認できていませんが、画像のような雰囲気です。 pic.twitter.com/DWEsuV1U1a

— いみひと (@nukie_53) 2019年6月18日

Public Sub Sample()
  Dim eu As Outlook.ExchangeUser
   
  Set eu = GetExchangeUserByAddress("hoge@hogepomehoge.onmicrosoft.com")
  If Not eu Is Nothing Then
    Debug.Print eu.Name, eu.Department, eu.PrimarySmtpAddress
  End If
End Sub
 
Private Function GetExchangeUserByAddress(ByVal SmtpAddress As String) As Outlook.ExchangeUser
  Dim myList As Outlook.AddressList
  Dim ae As Outlook.AddressEntry
  Dim eu As Outlook.ExchangeUser
  Dim ret As Outlook.ExchangeUser
   
  Set myList = Application.Session.GetGlobalAddressList
  For Each ae In myList.AddressEntries
    Select Case ae.AddressEntryUserType
      Case olExchangeUserAddressEntry, olExchangeRemoteUserAddressEntry '環境に応じて変更
        Set eu = ae.GetExchangeUser
        If eu.PrimarySmtpAddress = SmtpAddress Then
          Set ret = eu
          Exit For
        End If
    End Select
  Next
  Set GetExchangeUserByAddress = ret
End Function

処理の流れは下記の通りです。