Excel

Extract Email Data From Outlook Global Address List - GAL

Ease of Use

Intermediate

Version tested with

2000, 2002 

Submitted by:

brettdj

Description:

Extracts the detailed email address data for each user from an Outlook GAL to a summary sheet. 

Discussion:

Dumping the GAL to Excel provides an list in a form that can be easily searched or summarized. I recently had a phone call that was garbled and I caught only a fragment of his mobile phone number. I was able to quickly find this person's details by searching the Excel list. Can also be used to find multiple addresses in the GAL or to filter the GAL by location. 

Code:

instructions for use

			

Option Explicit Const CdoAddressListGAL = 0 Const CdoUser = 0 Const CdoRemoteUser = 6 #Const EarlyBind = True Sub GetGAL() 'Requires Excel 2000 as it uses Array Dim X As Variant, CDOList As Variant, TitleList As Variant, CDOitem As Variant Dim NumX As Long, ArrayDump As Long, i As Long, v As Long, u As Long 'Change the #Const to True to enable Early Binding #If EarlyBind Then Dim objSession As MAPI.Session, oFolder As MAPI.AddressList, oMessage As MAPI.AddressEntry Set objSession = New MAPI.Session CDOList = Array(CdoPR_DISPLAY_NAME, CdoPR_GIVEN_NAME, CdoPR_SURNAME, 972947486, CdoPR_ACCOUNT, _ CdoPR_TITLE, CdoPR_OFFICE_TELEPHONE_NUMBER, CdoPR_MOBILE_TELEPHONE_NUMBER, CdoPR_PRIMARY_FAX_NUMBER, _ CdoPR_COMPANY_NAME, CdoPR_DEPARTMENT_NAME, 974716958, CdoPR_STREET_ADDRESS, _ CdoPR_LOCALITY, CdoPR_STATE_OR_PROVINCE, CdoPR_COUNTRY, _ CdoPR_ASSISTANT, CdoPR_ASSISTANT_TELEPHONE_NUMBER) #Else Dim objSession As Object, oFolder As Object, oMessage As Object Set objSession = CreateObject("MAPI.Session") CDOList = Array(805371934, 973471774, 974192670, 972947486, 973078558, 974585886, _ 973602846, 974913566, 975372318, 974520350, 974651422, 974716958, 975765534, _ 975634462, 975699998, 975568926, 976224286, 976093214) #End If With objSession .Logon , , False, False Set oFolder = .GetAddressList(CdoAddressListGAL) End With TitleList = Array("GAL Name", "Given Name", "Surname", "Email address", "Logon", "Title Field", _ "Telephone", "Mobile", "Fax", "CSG/Group", "Department", "Site", "Address", "Location", "State ", _ "Country Field", "Assistant Name", "Assistant Phone") 'Grab 2000 records in one hit before writing to sheet ArrayDump = 2000 Cells.Clear 'Add Titles With Range("A1").Resize(1, UBound(TitleList) + 1) .Formula = TitleList .HorizontalAlignment = xlCenter .Interior.ColorIndex = 35 .Font.Bold = True .Font.Size = 12 End With ReDim X(1 To ArrayDump, 1 To UBound(CDOList) + 1) On Error Resume Next 'Some fields may not exist 'Turn off screen updating Application.ScreenUpdating = False For Each oMessage In oFolder.AddressEntries Select Case oMessage.DisplayType Case CdoUser, CdoRemoteUser i = i + 1 'Reset variant array every after each group of records If i Mod (ArrayDump + 1) = 0 Then 'Check that records do notexceed one sheet If NumX * ArrayDump + i > 65535 Then MsgBox "GAL exceeds 65535 entries - extraction stopped ", vbCritical + vbOKOnly GoTo FastExit End If 'Dump data NumX = NumX + 1 Range("A2").Offset((NumX - 1) * ArrayDump, 0).Resize(ArrayDump, UBound(CDOList) + 1) = X ReDim X(1 To ArrayDump, 1 To UBound(CDOList) + 1) i = 1 End If 'Display status to user If i Mod ArrayDump = 0 Then Application.StatusBar = "Entry " & i + u + NumX * ArrayDump & " of " & oFolder.AddressEntries.Count DoEvents End If v = 0 ' Add detail to each address For Each CDOitem In CDOList v = v + 1 X(i, v) = oMessage.Fields(CDOitem) Next Case Else u = u + 1 End Select Next 'dump remaining entries Range("A2").Offset(NumX * ArrayDump, 0).Resize(ArrayDump, UBound(CDOList) + 1) = X 'cleanup FastExit: ActiveSheet.UsedRange.EntireRow.WrapText = False Cells.EntireColumn.AutoFit Application.StatusBar = "" Application.ScreenUpdating = True Set oFolder = Nothing Set objSession = Nothing End Sub

How to use:

  1. Copy the code above.
  2. Open your workbook.
  3. Hit Alt+F11 to open the Visual Basic Editor (VBE).
  4. From the menu, choose Insert-Module.
  5. Paste the code into the code window at right.
  6. While in the VBE, choose Tools - References and put a check in MicroSoft CDO 1.21 Library
  7. Close the VBE, and save the file if desired.
 

Test the code:

  1. Run the macro by going to Tools-Macro-Macros and double-click GetGAL
 

Sample File:

GetGALEx.zip 12.92KB 

Approved by mdmackillop


This entry has been viewed 444 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express