Here is some code that I have used... It returns all of the addresses from
the global address list. The code requires a reference to the CDO 1.??
library. Note that when the code runs a security dialog will ask the user to
allow access to the Address list as this code could be used to propogate
viruses. You may need to change a number of settings to make this work for
your particular application. You will want to look up MAPI and CDO... This is
not simple stuff, so if you are not comfortable with this you may want to
avoid this all together.

Option Explicit

Const CdoPR_EMS_AB_PROXY_ADDRESSES = &H800F101E
Const g_strMAPILogOn As String = "MS Exchange Settings"
Const g_strAddressList As String = "Global Address List"
Const g_strEMailAddressIdentifier As String = "SMTP"

Public Sub GetEMailAddress()
Dim objSession As MAPI.Session
Dim objField As MAPI.Field
Dim MyAddressList As MAPI.AddressList
Dim MyAddressEntries As MAPI.AddressEntries
Dim MyEntry As MAPI.AddressEntry
Dim SomeEntry As MAPI.AddressEntry
Dim MyRecipient As MAPI.Recipient
Dim v As Variant
Dim rng As Range
Dim intCounter As Integer

Set rng = Sheet1.Range("A2")


' Create Session object and Logon.
Set objSession = CreateObject("MAPI.Session")
objSession.Logon (g_strMAPILogOn)

'Create the Address list from the Global Address List
Set MyAddressList = objSession.AddressLists(g_strAddressList)
If MyAddressList Is Nothing Then
MsgBox g_strAddressList & " Unavailable!", vbCritical, "Critical
Error"
Exit Sub
End If

'Initialize MyAddressEntires with the entries in the Address List
Set MyAddressEntries = MyAddressList.AddressEntries

'Traverse through the entries searching for a match
For Each SomeEntry In MyAddressEntries
Set MyEntry = SomeEntry

Set objField = MyEntry.Fields(CdoPR_EMS_AB_PROXY_ADDRESSES)

' PR_EMS_AB_PROXY_ADDRESSES is a multivalued property
(PT_MV_TSTRING).
' Therefore, you need to extract the individual members.
intCounter = 0
For Each v In objField.Value
If InStr(1, UCase(v), g_strEMailAddressIdentifier) Then
rng.Offset(0, intCounter).Value = Mid(v, 6, 256)
intCounter = intCounter + 1
End If
Next 'Next Field Value
Set rng = rng.Offset(1, 0)
Next 'Next Address Entry


'Housekeeping
Set objField = Nothing
Set MyAddressList = Nothing
Set MyAddressEntries = Nothing
Set MyEntry = Nothing
Set MyRecipient = Nothing
objSession.Logoff
Set objSession = Nothing

End Sub

--
HTH...

Jim Thomlinson


"William" wrote:

Dear,

i would have a program in excel for select outlook's contacts and fill into
excel. will here any existing solution for?

thanks,
William