VBAを使用してプライマリSMTPアドレス以外のMicrosoft Exchange電子メールアドレスを取得する方法

Question

ExcelでVBAを使用してOutlook.ExchangeUserオブジェクトから連絡先情報を取得しようとしています。しかし、これまでのところ、各ユーザーのプライマリSMTPアドレスを取得することしかできませんでしたが、可能であれば、各アカウントにすべての電子メールアドレスをリンクさせたいと考えています。私たちは最近ブランド変更して新しいドメインを取得したので、新しい電子メールアドレスが私たちの主要な電子メールアドレスになりました - しかし、私はまたこれと一緒に古いアドレスのすべてを抽出したいと思います。電子メールアドレス）。

同僚は私にで動作するように次のコードを与えた：

Sub GetAllGALMembers() 

Dim i As Long, j As Long, lastRow As Long 
Dim olApp As Outlook.Application 
Dim olNS As Outlook.Namespace 
Dim olGAL As Outlook.AddressList 
Dim olEntry As Outlook.AddressEntries 
Dim olMember As Outlook.AddressEntry 

Set olApp = Outlook.Application 
Set olNS = olApp.GetNamespace("MAPI") 
Set olGAL = olNS.GetGlobalAddressList() 

'Set Up Excel 
Dim wb As Workbook, ws As Worksheet 

'set the workbook: 
Set wb = ThisWorkbook 
'set the worksheet where you want to post Outlook data: 
Set ws = wb.Sheets("Sheet1") 

'clear all current entries 
Cells.Select 
Selection.ClearContents 

'set and format headings in the worksheet: 
ws.Cells(1, 1).Value = "First Name" 
ws.Cells(1, 2).Value = "Last Name" 
ws.Cells(1, 3).Value = "Email" 
ws.Cells(1, 4).Value = "Title" 
ws.Cells(1, 5).Value = "Department" 
Application.ScreenUpdating = False 
With ws.Range("A1:E1") 

.Font.Bold = True 
.HorizontalAlignment = xlCenter 

End With 

Set olEntry = olGAL.AddressEntries 
On Error Resume Next 
'first row of entries 
j = 2 

' loop through dist list and extract members 
For i = 1 To olEntry.Count 

Set olMember = olEntry.Item(i) 

If olMember.AddressEntryUserType = olExchangeUserAddressEntry Then 
'add to worksheet 
ws.Cells(j, 1).Value = olMember.GetExchangeUser.LastName 
ws.Cells(j, 2).Value = olMember.GetExchangeUser.FirstName 
ws.Cells(j, 3).Value = olMember.GetExchangeUser.PrimarySmtpAddress 
ws.Cells(j, 4).Value = olMember.GetExchangeUser.JobTitle 
ws.Cells(j, 5).Value = olMember.GetExchangeUser.Department 
j = j + 1 
End If 
Next i 
Application.ScreenUpdating = True 
'determine last data row, basis column B (contains Last Name): 
lastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row 

'format worksheet data area: 
ws.Range("A2:E" & lastRow).Sort Key1:=ws.Range("B2"), Order1:=xlAscending 
ws.Range("A2:E" & lastRow).HorizontalAlignment = xlLeft 
ws.Columns("A:E").EntireColumn.AutoFit 

wb.Save 

'quit the Outlook application: 
applOutlook.Quit 

'clear the variables: 
Set olApp = Nothing 
Set olNS = Nothing 
Set olGAL = Nothing 

End Sub 

これは本当によく働いている、しかし私は得ることができるすべてが.GetExchangeUser.PrimarySmtpAddressプロパティを介して、各ユーザーのための単一の電子メールアドレスです。

私はOutlook Object Model Reference for the ExchangeUser Objectを確認しましたが、これはExchangeUser.PrimarySmtpAddressプロパティのみを含み、その他の関連プロパティは含まれていません。

ユーザーに関連付けられたすべてのメールアドレスを取得する方法はありますか？それとも、プライマリアドレスだけを取得することに限定されていますか？

Answer 1

実際に面白かったです。私は私のワークステーションに戻ったときにExcelのマクロを調べなければなりません。面白い。警告として、Exchange管理シェルにはExcelでExchangeマクロを使用できるため、インストールされていると想定される方法があります。私はその仮定で間違っているかもしれないが、ここでは、とにかく行く：

Import-csv <location of your source csv file> | Get-ADUser $_.Username -Properties Surname, GivenName, @{N="EmailAddresses"; E={$_.ProxyAddresses | % {[string]::join("|",$_)}}}, Title, Department} | Export-csv <location you want to save it> -NoTypeInformation 

：あなたはCSVファイルですでにチェックしたいすべてのユーザーがいる場合

Get-MailboxDatabase -IncludePreExchange2013 | Get-mailbox | % { Get-ADUser $_.Alias -Properties Surname, GivenName, @{N="EmailAddresses"; E={$_.ProxyAddresses | % {[string]::join("|",$_)}}}, Title, Department} | Export-csv <location you want to save it> -NoTypeInformation 

は、あなたはまた、次の操作を行うことができ

あなたのCSVファイルに、検索しようとしているアカウントのユーザー名を持つ「ユーザー名」という列があることを確認してください。

Answer 2

AddressEntry.PropertyAccessor.GetPropertyを使用してPR_EMS_AB_PROXY_ADDRESSES MAPIプロパティ（DASL名http://schemas.microsoft.com/mapi/proptag/0x800F101F）を読む必要があります。これは多値のプロパティなので、文字列の配列を返すことになります。

OutlookSpyにプロパティとその値が表示されます（IMAPISession | QueryIdentityボタンまたはIAddrBookをクリックし、問題のGALエントリまでドリルダウンします）。