I'm attempting to pull contact information from an Outlook.ExchangeUser object using VBA in Excel. However, so far I've only been able to get the primary SMTP address for each user - but I would like to get EVERY email address linked to each account if possible. We recently rebranded and got a new domain, and so the new email address has become our primary email address - but I would also like to extract all of the old addresses alongside this, as these are still usable (and some have more than one older email address).
A colleague gave me the following code to work with:
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
This is working really well, however all I can get is a single email address for each user, through the .GetExchangeUser.PrimarySmtpAddress property.
I've checked the Outlook Object Model Reference for the ExchangeUser Object but this only includes the ExchangeUser.PrimarySmtpAddress Property, and no other relevant properties.
Is there a way to pull every email address associated to a user? Or am I limited to only getting the primary address and no others?
Interesting indeed. I'll have to look into macros in Excel for this when I get back to my work station. Interesting. As a caveat, there is a way in the Exchange Management Shell, which I assume is installed since you can use Exchange macros in Excel. I could be wrong in that assumption, but here it goes anyway:
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
If you have all the users you want to check already in a CSV file, you could also do the following:
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
Just make sure you have a column called "Username" in your CSV file that has the accounts' username that you are trying to look up.