Extract AddressEntry object details for Exchange User - vba

Question

Is there a way to extract the details in this dialog box via VBA?
Details Dialog Box http://i.msdn.microsoft.com/dynimg/IC84336.gif
I need, especially the content in the E-Mail address tab.

Answer 1

You can pretty much get the fields easily, the E-mail Addresses is the harder part. References: Microsoft Exchange Property Tags
This code exports some details but most importantly the Email addresses to a text file.
Sub ListGAL()
On Error Resume Next
Const LogFile = "C:\Test\OLK_GAL.log"
Const sSCHEMA = "http://schemas.microsoft.com/mapi/proptag/0x"
Const PR_EMS_AB_PROXY_ADDRESSES = &H800F101E
Dim oNameSpace As NameSpace, oGAL As AddressList, oEntry As AddressEntry
Dim oFSO As Variant, oLF As Variant, oExUser As ExchangeUser, i As Long
' Oulook objects
Set oNameSpace = Outlook.Application.GetNamespace("MAPI")
' Global Address List object
Set oGAL = oNameSpace.AddressLists("Global Address List")
'----------
' Log file objects
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oLF = oFSO.CreateTextFile(LogFile)
'----------
For Each oEntry In oGAL.AddressEntries
i = i + 1
Debug.Print i & vbTab & oEntry.Name
If oEntry.AddressEntryUserType = olExchangeUserAddressEntry Then
oLF.WriteLine "Entry " & i & " (olExchangeUserAddressEntry)"
oLF.WriteLine "Name: " & oEntry.Name
oLF.WriteLine "Address: " & oEntry.Address
Set oExUser = oEntry.GetExchangeUser
' SMTP ADDRESSES
oLF.WriteLine "SMTP Addresses:"
oLF.WriteLine vbTab & Join(oExUser.PropertyAccessor.GetProperty(sSCHEMA & Hex(PR_EMS_AB_PROXY_ADDRESSES)), vbCrLf & vbTab)
Set oExUser = Nothing
oLF.WriteLine String(50, Chr(151)) ' Separator
End If
Next
'----------
' Close Log File, clean up
oLF.Close
Set oGAL = Nothing
Set oNameSpace = Nothing
Set oLF = Nothing
Set oFSO = Nothing
End Sub

Answer 2

i have go a function of reading the address-book:
Function Get_mail(Absender As String)
Dim OutApp As Outlook.Application
Dim OutTI As Outlook.TaskItem
Dim OutRec As Outlook.Recipient
Set OutApp = New Outlook.Application
Set OutTI = OutApp.CreateItem(3)
OutTI.Assign
Set OutRec = OutTI.Recipients.Add(Absender)
OutRec.Resolve
If OutRec.Resolved Then
On Error GoTo exit_function
Get_mail = OutRec.AddressEntry.GetExchangeUser.PrimarySmtpAddress
End If
exit_function: Exit Function
Set OutApp = Nothing
Set OutTI = Nothing
End Function
as far as I know you can only read out the Primary Mail-address from the mail-addresses-tab; to see what else there ist delete the part ".PrimarySmtpAddress", mahe the dot and you should get the list of other properties.
I am quite sure you need the reference on Microsoft Outlook 14.0 Object Library.
The Input "Absender" can be any string . if this string can be resolved as address book-entry in an outlook-mail, you will also have a positive result from the code above.
To call the function, if for example you have a string "mail_adress_from_adressbook" you would put:
mail_adress_from_adressbook = get_mail("Joe Smith")
I hope this helps,
Max

Answer 3

Sure, you can access any GAL object property shown by Outlook (and then some) even if the properties are not explicitly exposed by the AddressEntry or ExchangeUser objects using AddressEntry.PropertyAccessor.GetProperty as long as you know the MAPI property's DASL name
The DASL property names can be retrieved using OutlookSpy (I am its author): either click IAddrBook button to drill down to a particular address entry or, if you have a message addressed to one of the GAL recipients, click IMessage button, go to the GetRecipientTable tab, double click on the recipient to open it as IMailUser:
In your particular case, you need PR_EMS_AB_PROXY_ADDRESSES (DASL name "http://schemas.microsoft.com/mapi/proptag/0x800F101F") - it is a multivalued string property, which means AddressEntry.PropertyAccessor.GetProperty will return an array of strings. Each value is prefixed with the address type (e.g. "EX:" or "smtp:"), the default SMTP address will be prefixed with "SMTP:" (note the upper case):
Set User = Application.session.CurrentUser.AddressEntry
AddressList = User.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x800F101F")
If IsArray(AddressList) Then
For i = LBound(AddressList) To UBound(AddressList)
MsgBox AddressList(i)
Next
End If