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.
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.FirstName ws.Cells(j, 2).Value = olMember.GetExchangeUser.LastName 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.