如何使用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属性为每个用户获得一个单独的电子邮件地址。

我已经检查了ExchangeUser对象的Outlook对象模型引用，但这只包括ExchangeUser.PrimarySmtpAddress属性，没有其他相关属性。

有没有一种方法可以提取与用户关联的每个电子邮件地址？还是我只能获得主地址而不能获得其他地址？

Answer 1

您需要使用AddressEntry.PropertyAccessor.GetProperty读取PR_EMS_AB_PROXY_ADDRESSESMAPI属性(DASL名称http://schemas.microsoft.com/mapi/proptag/0x800F101F)。它是一个多值属性，因此您将返回一个字符串数组。

您可以在OutlookSpy中查看属性及其值(我是它的作者-单击IMAPISession | QueryIdentity按钮或IAddrBook，然后深入到有问题的GAL条目)。

Answer 2

确实很有趣。当我回到工作站时，我必须在Excel中查看宏。有趣的需要注意的是，Exchange命令行管理程序中有一种方法，我认为它是安装的，因为您可以在Excel中使用Exchange宏。我的假设可能是错误的，但不管怎样，它是这样的：

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文件中了，你也可以做以下操作：

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文件中有一个名为"用户名"的列，其中包含您要查找的帐户的用户名。