Extract GAL members to Excel
March 30, 2009 • JP • 24 Comments • Rate This Article
In a comment to Outlook Version of GetDistListMembers, Lee asks if we can extract information from the Global Address List (GAL).
Here's what I came up with. It's untested, so let me know if it doesn't work.
Function WriteGALMembersToExcel(ListName As String) As Boolean
' adapted from http://www.slovaktech.com/code_samples.htm#DLToWord
' writes dist list members to a worksheet, one row for each contact in dist list
On Error GoTo ErrorHandler
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olAL As Outlook.AddressList
Dim olEntry As Outlook.AddressEntry
Dim oldlMember As Outlook.AddressEntry
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olAL = olNS.AddressLists("Global Address List")
Set olEntry = olAL.AddressEntries(ListName)
' get count of dist list members
Dim lMemberCount As Long
lMemberCount = olEntry.Members.Count
' create temp variant and set size to one row for each contact
Dim tempVar As Variant
ReDim tempVar(1 To lMemberCount, 1 To 2)
' loop through dist list and extract members
Dim i As Long
For i = 1 To lMemberCount
Set oldlMember = olEntry.Members.Item(i)
tempVar(i, 1) = oldlMember.Name
tempVar(i, 2) = oldlMember.Address
Next i
' get new Excel instance
Dim xlApp As Object ' Excel.Application
Dim xlBk As Object ' Excel.Workbook
Dim xlSht As Object ' Excel.Worksheet
Dim rngStart As Object ' Excel.Range
Dim rngHeader As Object ' Excel.Range
Set xlApp = GetExcelApp
If xlApp Is Nothing Then GoTo ExitProc
xlApp.ScreenUpdating = False
Set xlBk = xlApp.Workbooks.Add
Set xlSht = xlBk.Sheets(1)
' set up worksheet and write to range
xlSht.Name = ListName
Set rngStart = xlSht.Range("A1")
Set rngHeader = xlSht.Range(rngStart, rngStart.Offset(0, 1))
rngHeader.Value = Array("Name", "Email Address")
rngStart.Offset(1, 0).Resize(UBound(tempVar), 2).Value = tempVar
' if we got this far, assume success
WriteGALMembersToExcel = True
xlApp.Visible = True
GoTo ExitProc
ErrorHandler:
ExitProc:
On Error Resume Next
Erase tempVar
Set rngHeader = Nothing
Set rngStart = Nothing
Set xlSht = Nothing
Set xlBk = Nothing
Set xlApp = Nothing
Set olAL = Nothing
Set olEntry = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Function
Function GetExcelApp() As Object
' always create new instance
On Error Resume Next
Set GetExcelApp = CreateObject("Excel.Application")
On Error GoTo 0
End Function
' adapted from http://www.slovaktech.com/code_samples.htm#DLToWord
' writes dist list members to a worksheet, one row for each contact in dist list
On Error GoTo ErrorHandler
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olAL As Outlook.AddressList
Dim olEntry As Outlook.AddressEntry
Dim oldlMember As Outlook.AddressEntry
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olAL = olNS.AddressLists("Global Address List")
Set olEntry = olAL.AddressEntries(ListName)
' get count of dist list members
Dim lMemberCount As Long
lMemberCount = olEntry.Members.Count
' create temp variant and set size to one row for each contact
Dim tempVar As Variant
ReDim tempVar(1 To lMemberCount, 1 To 2)
' loop through dist list and extract members
Dim i As Long
For i = 1 To lMemberCount
Set oldlMember = olEntry.Members.Item(i)
tempVar(i, 1) = oldlMember.Name
tempVar(i, 2) = oldlMember.Address
Next i
' get new Excel instance
Dim xlApp As Object ' Excel.Application
Dim xlBk As Object ' Excel.Workbook
Dim xlSht As Object ' Excel.Worksheet
Dim rngStart As Object ' Excel.Range
Dim rngHeader As Object ' Excel.Range
Set xlApp = GetExcelApp
If xlApp Is Nothing Then GoTo ExitProc
xlApp.ScreenUpdating = False
Set xlBk = xlApp.Workbooks.Add
Set xlSht = xlBk.Sheets(1)
' set up worksheet and write to range
xlSht.Name = ListName
Set rngStart = xlSht.Range("A1")
Set rngHeader = xlSht.Range(rngStart, rngStart.Offset(0, 1))
rngHeader.Value = Array("Name", "Email Address")
rngStart.Offset(1, 0).Resize(UBound(tempVar), 2).Value = tempVar
' if we got this far, assume success
WriteGALMembersToExcel = True
xlApp.Visible = True
GoTo ExitProc
ErrorHandler:
ExitProc:
On Error Resume Next
Erase tempVar
Set rngHeader = Nothing
Set rngStart = Nothing
Set xlSht = Nothing
Set xlBk = Nothing
Set xlApp = Nothing
Set olAL = Nothing
Set olEntry = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Function
Function GetExcelApp() As Object
' always create new instance
On Error Resume Next
Set GetExcelApp = CreateObject("Excel.Application")
On Error GoTo 0
End Function
Usage:
Sub test()
Dim success As Boolean
success = WriteGALMembersToExcel("Executive Management")
End Sub
Dim success As Boolean
success = WriteGALMembersToExcel("Executive Management")
End Sub
Automation, Excel, Outlook ·
Rate This Article:
(1 votes, average: 1.00 out of 5)
Loading ...What now?
Subscribe To The Blog
Email This Article
Follow Me On Twitter
My Facebook Page
Or just keep reading:
I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space if you want to learn more about VBA. Keep Reading »
Previous Post: Attach files in a folder to one email
Next Post: Extract Calendar data from Outlook, Redux
Small change required for a boolean
' if we got this far, assume success
WriteGALMembersToExcel = True
Oops. Thanks Curtis, I updated the code above.
Wow thanks, this is great!
I have made just one alteration – I've added a left() function around ListName to truncate very long distribution lists names as 30 characters is the maximum Excel will allow.
The line that changes the sheet name (line 51) now looks like:
In Excel 2003 I can enter 31 characters as a sheet name.
Nice work, but what if you have distlist inside the "Main" dist list?
The 'oldlMember.Address' field is coming up with an exchange alias not the actual email address.
Can you tell me how I access the contact properties in a similar way to the 'GetDistListMembers' code that uses the default contacts folder and the Recipient and DistList objects?
I've tried numerous scripts trying to access the GAL and so far I have not been able to. I keep getting an error when it reaches the line:
It is saying
All I want to be able to do is pull a phone number from a specified contacts alias.
Jason,
I didn't see the error message in your comment. Are you able to access the GAL manually? Have you changed the code at all?
I'm not an administrator so I don't have root access or anything like that. I can view the GAL with Outlook and see everything about everyone in there but I just can't seem to get in there via VBA.
When you browse do you see the words "Global Address List" ? If it's renamed, it might appear differently.
It is spelled correctly. Am I just missing a reference or something? I thought I had them all but I could be missing something.
At this point the only thing I can think of is that either the name is different (i.e. instead of "Global Address List" they call it something else) or programmatic access is restricted.
Once again, you are a life-saver. But one thing I can't get:
I have adapted this slightly so that testing it I run it as a sub looking for myself. What I am trying to do is extract the Department property of the address item. I have used other stuff you have produced to pull in data from an outlook form into a spreadsheet, and the customer now wants the "branch" and extension of the user who submitted the feedback form to be included in the database.
Not wanting to get users to enter stuff they don't need to, I want to be able to pull those two items from the GAL for the user identified as the sender of the outlook item.
How do I do this? Can't find a property of AddressItem that gives me this. I guess I am at a level too low down and need to go up in the heirarchy to get it.
I did find something that required the creation of a new session and uses the CDO library and AddressEntries(username).Fields(974651422) to get the Department name. But I'd like to do it without having to create a new session.
Looks like you figured it out. I assumed it was something CDO-related. Outlook version?
Yeah – I was running into problems because I forgot to set the reference to the Microsoft CDO 1.21 library.
Gotta say – all this is a heap of fun. Going from never having seen a form in detail several weeks ago to being able to get my form to:
scan the mailbox for reference numbers and create the next sequential reference number for the form (bit of a bugger that I can't seem to simply format the reference number as "0000" in VBScript – had to create a loop inserting leading zeroes until len = 4);
insert the contents of the form into a spreadsheet including extracting GAL information about the user
Has been quite a ride. I had been told automating from Outlook to Excel was not possible and knew it was – just taken a while to figure out how.
Using Outlook 2003.
I am guessing that, now I am pushing data from Outlook to Excel, I don't need to create a new session and just need to keep my Outlook Application object defined.
JP, I am getting an Runtime error # 13 at line "Erase tempVar", line # 68. Any reason why?
No, but you don't really need that line anyway.
Yeah, I tried by deleting that line too, but the code runs without doing anything…… just can't figure out why, since many out here have had success with it.
Try stepping through the code and see what happens. It's meant to be used from Outlook; if you are using it in Excel, you'll need to adapt the code found at Extract distribution list members to Excel instead.
Have you stepped through the code to see what happens at each line?
If you are not getting the new workbook created, then then entire Function is failing. If you get the workbook created, and the header line created, then you will most likely have a problem with naming conventions of the GAL.
I suspect that if you step through, ErrorHandler will be triggered early on – possibly because you need certain References loaded in the Outlook Tools-References.
Alternatively, if the object you are looking for in the actual Test sub is not a group, it will go straight to ErrorHandler.
If you want the details for an individual address, you need:
' get count of dist list members
'Dim lMemberCount As Long
'olAL = olEntry.Members.Count
'
" create temp variant and set size to one row for each contact
Dim tempVar As Variant
ReDim tempVar(1, 1 To 2)
' loop through dist list and extract members
'Dim i As Long
'For i = 1 To lMemberCount
' Set oldlMember = olEntry.Members.Item(i)
' tempVar(i, 1) = oldlMember.Name
' tempVar(i, 2) = oldlMember.Address
'Next i
tempVar(1, 1) = olEntry.Name
tempVar(1, 2) = olEntry.Address
You have to loop through all items in the address list (rather than members of a distribution group) to get what you want.
At least I really hope this is right. Comments, JP??
Gravey.
You're right
Gentlemen,
Thanks for your efforts here.
JP, First I must say I made the error of trying to run this in the Excel Application, however even in Outlook it does the same. Stepping through the code I notice, that at line 21,
lMemberCount = olEntry.Members.Count
The procedure begins to make its exit.
I adopted Garvey's approach, by subsituting the corresponding lines, same prob.
Garvey, I have the following Reference Libraries turned on:
Visual Basic for Applications
Microsoft Outlook 12.0 Object Library
Ole Automation
Microsoft CDO 1.21 Library
Microsoft Office 12.0 Object Library
Microsoft Scripting Runtime
Microsoft Excel 12.0 Object Library
Microsoft Word 12.0 Object Library
Microsoft Outlook 12.0 Object Library
Do I need to add anymore to this?
You don't need any object library references to compile or run the code.
1. What is the error message?
2. Are you running this in an Exchange environment? It generally won't work on a home PC.
3. Can you run VBA code in Outlook at all? If not, it may have been blocked completely by your sysadmin.
4. After you run the following line, is olAL equal to Nothing?
Set olAL = olNS.AddressLists("Global Address List")
5. After you run the following line, is olEntry equal to Nothing?
Set olEntry = olAL.AddressEntries(ListName)
If so, you'll want to check that you have a GAL named "Global Address List".