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.
Great script!
Is there a way to get the membership of distribution list(s) per user?
Thanks in advance.
John
Great script!
Is there a way to get also the membership of the distribution list(s) a user belongs to?
Thanks for reply
John
Exchange DLs: You could, but I don't think I have a macro for that. (Will check.)
Outlook DL (contact group): Yes, I have a macros that can do it. The first adds a category to the contacts in the contact group, the second makes a list.
https://www.slipstick.com/developer/add-category-contact-contact-group-dl/
https://www.slipstick.com/outlook/people/find-the-distribution-lists-contact-groups-a-contact-belongs-to/
gread, Thx is working very well
Thank you Diane this code is really helpfull.
With respect to your posting about redemption at https://answers.microsoft.com/en-us/msoffice/forum/msoffice_outlook-mso_win10-mso_2016/outlook-automation-querying-global-address-list/bfc82bf6-ad26-4ffc-90a9-fefc96283d6a...
Can "Set olEntry = olAL.AddressEntries("Diane Poremsky")" be used to look up the PrimarySmtpAddress, and is the PrimarySmtpAddress case dependent?
I ask because I have the PrimarySmtpAddress, but it's in lower case, and our GAL is in camel-case.
Yes, it is case-sensitive. I tested it using the macro here - https://www.slipstick.com/developer/code-samples/use-vba-to-create-a-list-of-exchange-gal-members/
I changed the If line to
If olMember.Name = "diane poremsky" Then
and have nothing returned. Using proper case found my 2 entries.
using lcase on the GAL name works:
If LCase(olMember.Name) = "diane poremsky" Then
As far as I know, redemption is also case-sensitive in the lookups. Dmitry doesn't mention it in his page here:
http://www.dimastr.com/redemption/rdo/rdoaddressbook.htm
It would be nice if you could specify "ignore case"... after all, using Outlook's address book lookup is case insensitive, (and unfortunately, does partial matches on what you enter, instead of eliminating the "less qualified" entries).
Thank you for the quick response and "fix".
I found that this is really slow if I have the outlook client open. When I close the outlook client, it is reasonably fast...
I want to export my GAL, and also sort my data. Is there a VBA code?
Hi Thomas
Thanks for the post, was looking for this, is there a way to make list only emails found an a range?
EG: i have a list of emails lets say in a sheet, and i want to extract the info for them, (comparing the email to defaultsmtpaddress.
would that reduce run time (i have 24K plus entries)