Search in GAL from another office application

[PaCoCourt]

Hi,
From xls, i'm trying to retrieve information (like mail, phone, ...) from
other colleagues. Idealy, the code must make a search in GAL. As, there are
thousands of entries looping through is verry time consumming.
Question
Is it possible to activate the search in GAL from xls or may be another
solution.
tks
P.

 

[Eric Legault [MVP - Outlook]]

Try the macros below in an Excel spreadsheet. Make sure you set a reference
to the Microsoft Collaboration Data Objects 1.21 library, and ensure that
Outlook is open. The code demonstrates searching the GAL for a particular
user name; all user details are output to the Immediate window.

Sub TestGetGALAddressDetails()
GetGALAddressDetails "John Doe"
End Sub

Sub GetGALAddressDetails(UserFullName As String)
On Error Resume Next

Dim objSession As New MAPI.Session
Dim objAdds As MAPI.AddressLists
Dim objAddress As MAPI.AddressEntry
Dim objGAL As MAPI.AddressList
Dim objFields As MAPI.Fields, objField As MAPI.Field

objSession.Logon , , , False

If objSession Is Nothing Then Exit Sub

Set objAdds = objSession.AddressLists
Set objGAL = objAdds.Item("Global Address List")
For Each objAddress In objGAL.AddressEntries
If objAddress.DisplayType = CdoUser Or objAddress.DisplayType =
CdoRemoteUser Then
If InStr(objAddress.Name, UserFullName) > 0 Then
Debug.Print "Name: " & objAddress.Name
Set objField = objAddress.Fields(CdoPR_BUSINESS_ADDRESS_CITY)
If Not objField Is Nothing Then Debug.Print objField.Value:
Set objField = Nothing
Set objField =
objAddress.Fields(CdoPR_BUSINESS_ADDRESS_COUNTRY)
If Not objField Is Nothing Then Debug.Print objField.Value:
Set objField = Nothing
Set objField =
objAddress.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE)
If Not objField Is Nothing Then Debug.Print objField.Value:
Set objField = Nothing
Set objField =
objAddress.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE)
If Not objField Is Nothing Then Debug.Print objField.Value:
Set objField = Nothing
Set objField =
objAddress.Fields(CdoPR_BUSINESS_ADDRESS_STREET)
If Not objField Is Nothing Then Debug.Print objField.Value:
Set objField = Nothing
Set objField = objAddress.Fields(CdoPR_TITLE)
If Not objField Is Nothing Then Debug.Print objField.Value:
Set objField = Nothing
Set objField = objAddress.Fields(CdoPR_COMPANY_NAME)
If Not objField Is Nothing Then Debug.Print objField.Value:
Set objField = Nothing
Set objField = objAddress.Fields(CdoPR_DEPARTMENT_NAME)
If Not objField Is Nothing Then Debug.Print objField.Value:
Set objField = Nothing
Set objField = objAddress.Fields(CdoPR_OFFICE_LOCATION)
If Not objField Is Nothing Then Debug.Print objField.Value:
Set objField = Nothing
Set objField = objAddress.Fields(CdoPR_ASSISTANT)
If Not objField Is Nothing Then Debug.Print objField.Value:
Set objField = Nothing
Set objField =
objAddress.Fields(CdoPR_BUSINESS_TELEPHONE_NUMBER)
If Not objField Is Nothing Then Debug.Print objField.Value:
Set objField = Nothing
End If
End If
Next

objSession.Logoff

Set objSession = Nothing
Set objAdds = Nothing
Set objAddress = Nothing
Set objGAL = Nothing
Set objFields = Nothing
Set objField = Nothing
End Sub

 

[PaCoCourt]

Tks for your answer. (could you apologize to react so late, due to vacation).
Proposed code resolve the problem but it's slow (3 to 4 sec.). Is it a way
to enhance reponse time ?

 

[Eric Legault [MVP - Outlook]]

I'd say 3-4 secs for looking through thousands of entries in your GAL is
quite acceptable.