Solved: Dumping Outlook GAL into Excel

[brettdj]

Warning: Excel guy slowly learning Outlook Object.....

I've used the following code from Excel (with the CDO 1.21 Ref) to pull my companies GAL of approx 36,000 names to a spreadsheet.

Is there a better approach than below?

Thanks

Dave

[vba]
Sub Geta()
Dim NewMapi As MAPI.Session, MapiAdd As MAPI.AddressList, MapiAddEn As MAPI.AddressEntry
Dim OutputAR(), i As Long

Set NewMapi = New MAPI.Session
NewMapi.Logon 1, 1, False, False
Set MapiAdd = NewMapi.AddressLists("Global Address List")

ReDim OutputAR(1 To MapiAdd.AddressEntries.Count, 1 To 4)

On Error Resume Next
'ID may not exists

'Grab Name
'Grab Address
'Grab Logon
'Grab email

For Each MapiAddEn In MapiAdd.AddressEntries
i = i + 1
OutputAR(i, 1) = MapiAddEn.Name
OutputAR(i, 2) = MapiAddEn.Fields(975765534) & Chr(10) & MapiAddEn.Fields(975634462)
OutputAR(i, 3) = MapiAddEn.Fields(972947486)
OutputAR(i, 4) = MapiAddEn.Fields(973078558)
Next

Cells(1, 1) = "Name"
Cells(1, 2) = "Location"
Cells(1, 3) = "Email"
Cells(1, 4) = "Logon"
Cells(2, 1).Resize(i, UBound(OutputAR, 2)) = OutputAR()

Set MapiAdd = Nothing
Set NewMapi = Nothing
End Sub
[/vba]

[jamescol]

Suggestions:

Use common names for the fields to make it more readable:


Name
Address: CdoPR_BUSINESS_ADDRESS_STREET = 975765534 (&H3A29001E)
City: CdoPR_BUSINESS_ADDRESS_CITY = 975634462 (&H3A27001E)
Email: CdoPR_EMAIL_ADDRESS = 805503006 (&H3003001E)
Logon: CdoPR_ACCOUNT = 973078558 (&H3A00001E)

Also, the CDO constant for "Global Address List" is CdoAddressListGAL. I always like to use defined constants wherever possible.

Unless you need to export the entire GAL, you can filter the type of objects by using CDODisplayType. For instance, if you only want Exchange Users, filter using:
[vba]
'Loop through users in the addresslist
If MAPIAdd.CDODisplayType = cdoUser Then
'.
'.
'.
End If
[/vba]

OR
[vba]

' Constrain the address entries collection.
Set CdoAddressEntryFilter = CdoAddressEntries.Filter
CdoAddressEntryFilter.cdoDisplayType = cdoUser

[/vba]

One last thought. Isn't it possible to copy the entire array rather than one row at a time? Seems like I read about that feature somewhere, and think it would be more efficient. Maybe one of the XL gurus can answer

Cheers,
James

[brettdj]

Thanks for the input James, I'll give that CDODisplayType a while

I used an array rather than a loop to dump the output to the sheet but I read in the addresses one at a time. I didn't think there was a way to create the filtered results array

Cheers

Dave

[jamescol]

Let me know how it turns out. I see now how you are copying the data into the worksheet. My XL VBA is not strong at all

James

[jamescol]

Hey Dave,
How did this work out for you?

James

[brettdj]

James,

Sorry for the long gap in replying...

I altered the code to
[vba]
Const CdoAddressListGAL = 0
Sub GAL()
Dim objSession As MAPI.Session, oAddressList As MAPI.AddressList, oEntry As MAPI.AddressEntry
Set objSession = New MAPI.Session
With objSession
.Logon , , False, False
Set oAddressList = .GetAddressList(CdoAddressListGAL)
On Error Resume Next
i = i + 1
For Each oEntry In oAddressList.AddressEntries
i = i + 1
Cells(i, 1) = oEntry.Fields(CdoPR_DISPLAY_NAME)
Cells(i, 2) = oEntry.Fields(CdoPR_GIVEN_NAME)
Cells(i, 3) = oEntry.Fields(CdoPR_OFFICE_TELEPHONE_NUMBER)
Cells(i, 4) = oEntry.Fields(CdoPR_ACCOUNT)
Next
End With
Set oAddressList = Nothing
Set objSession = Nothing
End Sub
[/vba]

I subsequently wrote code to extract details from my contacts, I tried two methods

1) Contacts via .GetDefaultFolder(CdoDefaultFolderContacts)
2) Contacts via the AddressList

From the output it seems that accessing Contacts via the AddressList isn't the way to go - there was only a limited amount of info returned by this method. I think its only the Contact info that is seen via the Address List if the user doesn't doubleclick on the entry. Is that your understanding?

[vba]
Const CdoDefaultFolderContacts = 5
Sub Approach1()
Dim objSession As MAPI.Session, oFolder As MAPI.Folder, oMessage As MAPI.Message
Set objSession = New MAPI.Session
With objSession
.Logon , , False, False
Set oFolder = .GetDefaultFolder(CdoDefaultFolderContacts)
On Error Resume Next
i = i + 1
For Each oMessage In oFolder.Messages
i = i + 1
Cells(i, 1) = oMessage.Fields(CdoPR_DISPLAY_NAME)
Cells(i, 2) = oMessage.Fields(CdoPR_GIVEN_NAME)
Cells(i, 3) = oMessage.Fields(CdoPR_OFFICE_TELEPHONE_NUMBER)
Cells(i, 4) = oMessage.Fields(CdoPR_ACCOUNT)
Next
End With
Set oFolder = Nothing
Set objSession = Nothing
End Sub

Sub Approach2()
Dim objSession As MAPI.Session, oAddressList As MAPI.AddressList, oEntry As MAPI.AddressEntry
Set objSession = CreateObject("MAPI.Session")
With objSession
.Logon , , False, False
Set oAddressList = .AddressLists("Contacts")
On Error Resume Next
i = i + 1
For Each oEntry In oAddressList.AddressEntries
i = i + 1
Cells(i, 1) = oEntry.Fields(CdoPR_DISPLAY_NAME)
Cells(i, 2) = oEntry.Fields(CdoPR_GIVEN_NAME)
Cells(i, 3) = oEntry.Fields(CdoPR_OFFICE_TELEPHONE_NUMBER)
Cells(i, 4) = oEntry.Fields(CdoPR_ACCOUNT)
Next
End With
Set oAddressList = Nothing
Set objSession = Nothing
End Sub

[/vba]

Cheers

Dave

[brettdj]

This thread has been getting a few hits

For those interested in this topic, I wrote up the code to dump the GAL into Excel, see http://www.vbaexpress.com/kb/getarticle.php?kb_id=222

I have attached a more-user friendly model with userform status here.

Cheers

Dave

[staffel]

Hallo, brettdj

I tried to use your GAL List, but some errors occured.

the program area which uses an array and tries to put it in an excelworksheet failed. Only the headline has been put into the first line of the excel sheet.

I dropped the errorhandling line and noticed that the array makes some problems. So I dropped this part until I reduced the code to put only the second line into the worksheet.
That was only possible with:
Const CdoAddressListGAL = 1 (Contacts)
if I put
Const CdoAddressListGAL = 0 (Globale Adressliste)
no transfer was possible.

I wanted to transfer the real "Global Address List" from Exchange2003 to Excel not only the "contacts from Outlook". I tried to get the addressentry.details from out of Exchange GAL not only the local personal addressbook.

I must have made something wrong or my equipment is wrong configured.
(ExchangeServer2003 german, Office2003Pro german with Outlook2003 german)

I hope somebody can help me.

greetings Marcus

[brettdj]

Hi Marcus

When this line runs
Set oFolder = .GetAddressList(CdoAddressListGAL)
What does oFolder refer to?

It shuld be pointing at the GAL

if you replace it with
Set oFolder = .AddressLists("Global Address List")
does anything change?

Cheers

Dave

[staffel]

When this line runs
Set oFolder = .GetAddressList(CdoAddressListGAL)
What does oFolder refer to? MsgBox(oFolder.name) shows: "Globale Adressliste"

It shuld be pointing at the GAL

if you replace it with
Set oFolder = .AddressLists("Global Address List")
does anything change?
Yes "Laufzeitfehler -2147221233 (8004010f):" (=RuntimeError -2147221233 (8004010f)

[ Collaboration Data Objects - MAPI_E_NOT_FOUND (8004010f) ]

but if I write
Set oFolder = .AddressLists("Globale Adressliste")
there is no error. It only consumes much time and nothing is put into the worksheet.
It seems that information will be loaded from exchange server (networktraffic), but i can see nothing. After 1-2 minutes the macro ends with no error. It seems to be a matter of national language support (nls) in my opinion or different configurations (Exchange2003/Exchange2000).
The time it takes to do nothing is a little long for six user-entries in my exchange-test-configuration.

regards Marcus