Hello everybody,

Í have a Namelist in Excel (Sheet1: row: A1) and I need the Email-Address for this names
from Outlook GAL. I found an Macro that works on Excel 2007, but I need one which is
working on Excel 2003.

Please can You help me?


OnBak



Private Const olExchangeGlobalAddressList As Integer = 0
Private Const olExchangeUserAddressEntry As Integer = 0
Private Const olExchangeRemoteUserAddressEntry As Integer = 5

Public Sub VergleichExcelMitGAL()
Dim oOutlook As Object
Dim oAddressList As Object
Dim oAddressEntry As Object
Dim oExchangeUser As Object
Dim Länge As Integer


Range("A1").Select
Set oOutlook = CreateObject("Outlook.Application")


For Each oAddressList In oOutlook.Session.AddressLists

If oAddressList.AddressListType = olExchangeGlobalAddressList Then

For Each oAddressEntry In oAddressList.AddressEntries

If oAddressEntry.AddressEntryUserType = olExchangeUserAddressEntry _
Or oAddressEntry.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then

Set oExchangeUser = oAddressEntry.GetExchangeUser


Range("A1").Select
While Selection <> ""
Länge = Len(ActiveCell)
If ActiveCell = Left(oExchangeUser.Alias, Länge) Then
Sheets(2).Select
Selection = oExchangeUser.Name
ActiveCell.Offset(0, 1) = oExchangeUser.Alias
ActiveCell.Offset(0, 2) = oExchangeUser.Email
ActiveCell.Offset(1, 0).Select
Sheets(1).Select
End If
ActiveCell.Offset(1, 0).Select
Wend
End If
Next
End If
Next

Set oExchangeUser = Nothing
Set oAddressEntry = Nothing
Set oAddressList = Nothing
Set oOutlook = Nothing
End Sub