Use VBA to Export Exchange GAL to Excel

This code sample was contributed by Thomas Hill.

Today, I found your procedure for extracting data from a GAL. Last week I found someone else's code for extracting from Contacts to Excel. When I cobbled the two together, I successfully exported the GAL to Excel, which is useful for a couple of processes here. It resides in Excel, so the Outlook library must be incorporated at design time.

For Outlook macros to extract GAL entries, see Use VBA to Create a List of Exchange GAL Members.

To use, you need to set a reference to Outlook object model in Excel's Tools, References menu.

It is slow!

Sub GetAllGALMembers()
'This is an Excel Macro
Dim i As Long, j as long, lastRow As Long
'Set up Outlook
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 = "Phone/Ext"
ws.Cells(1, 4).Value = "Email"
ws.Cells(1, 5).Value = "Title"
ws.Cells(1, 6).Value = "Department"
Application.ScreenUpdating = False
With ws.Range("A1:F1")

.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.BusinessTelephoneNumber
ws.Cells(j, 4).Value = olMember.GetExchangeUser.PrimarySmtpAddress
ws.Cells(j, 5).Value = olMember.GetExchangeUser.JobTitle
ws.Cells(j, 6).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:F" & lastRow).Sort Key1:=ws.Range("B2"), Order1:=xlAscending
ws.Range("A2:F" & lastRow).HorizontalAlignment = xlLeft
ws.Columns("A:F").EntireColumn.AutoFit

wb.Save

'quit the Outlook application:
applOutlook.Quit

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

End Sub

How to use the Macro

First: You will need macro security set to low during testing.

To check your macro security in Excel 2010 and up, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. Note: after you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Now open the VBA Editor by pressing Alt+F11 on your keyboard and paste the code into the Editor pane. More information is at How to use the VBA Editor.