Get Email from Outlook GAL to Namelist in Excel

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

Thank you adyteo, but it doesn't work..
I have a namelist and I need the Email-Address for those names. In this list are more than 1000 names :/
I'm new @vba and i have problems to write my own macro

I get this error message (Dim oExUser As Outlook.ExchangeUser):

compile error:
user-defined type not defined

It's already selected. I use "Microsoft Outlook 11.0 Object Library".
Can I upload my excel file?

test.xls

i dont know, why this isnt working..

Can I use another code for "Outlook.ExchangeUser" ?

Ah ok. I'm currently at work and they are using office 2003.

I'll try ur code later at home, when it works. i will tell you

Thank you.

Wouldn't it be easier to read this data from Active Directory?

I think this code below is an good alternative, for extracting Email from GAL:

'Send Mail
'OnBak 12.03.2014


Private Sub CommandButton1_Click()
Dim Nachricht As Object, OutlookApplication As Object
Set OutlookApplication = CreateObject("Outlook.Application")
Dim Anhang As String
Dim Adress As String
Dim sAddress As String, sSubject As String, sBody As String
Dim Name As String

Anhang = ThisWorkbook.FullName
Set Nachricht = OutlookApplication.CreateItem(0)

' Wo Wert = @, wird übernommen und ";" eingefügt
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeVisible)
If cell.Value = cell.Value Then
sAddress = sAddress & ";" & cell.Value
End If
Next

'Eingabe Betreff und Text
sSubject = InputBox("Please enter a subject", "Enter subject")
sBody = InputBox("Please enter your text here:", "Enter text")

'Übergabe
With Nachricht
.To = sAddress
.Subject = sSubject
.Attachments.Add "D:\LocalHome\bakis\My Documents\2. VBA practice\empty document.txt" 'Anhang
.Body = sBody
.Display
.Send
End With

Set OutlookApplication = Nothing
Set Nachricht = Nothing
End Sub