A couple of fcomments:

1. There is not reason to use MAPIUtils - RDOContactItem (derived from
RDOMail, derived in turn from MAPIProp), exposes the GetIDsFromNames. Or you
can simply pass the property tag as a DASL name when accessing the property
through Fields. More than that, you can simply read the
RDOContactItem.Email1Address and RDOContactItem.Email1EntryID properties.
2. There is no reason to parse anything - RDOAddressEntry.SmtpAddress is
guaranteed to return a valid SMTP address or an empty string.

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

"John" wrote in message
...
Hi All,

For what it's worth getting contact info in SMTP format for me was tough.
Turns out half of my contacts are coded as SMTP when they're really
exchange
(EX or X500) type. Anyhow, this thread was very useful, so to give back
some...please find below my Visual Basic Scripting (VBS) code to extract
SMTP
address from the contact book, evaluate them (to see if they are really
SMTP
or exchange), contact the Exchange to get the SMTP value if they are
exchange, and dump it all to an Excel spreadsheet.

Thanks to Dmitri for that awesome Redemption work, without which this
would
have been dare I say inprobable!!!

Regards!

'**************************************
'**************************************
'**************************************
Dim myItem
Dim myContacts
Dim myContact
Dim addressEntry
Dim RDOSession
Dim RDOAddressEntry
Dim Recipient

Dim objXL
Dim myOlApp
Dim utils
Dim myNamespace
Dim value

Set objXL = WScript.CreateObject("Excel.Application")
set utils = CreateObject("Redemption.MAPIUtils")
Set myOlApp = CreateObject("Outlook.Application")
Set myNamespace = myOlApp.GetNamespace("MAPI")
set RDOSession = CreateObject("Redemption.RDOSession")
RDOSession.MAPIOBJECT=myOlApp.Session.MAPIOBJECT
Set myContacts = RDOSession.GetDefaultFolder(10).Items

objXL.Visible = TRUE
objXL.WorkBooks.Add
objXL.Columns(1).ColumnWidth = 40
objXL.Columns(2).ColumnWidth = 40
objXL.Columns(3).ColumnWidth = 40
objXL.Cells(1, 1).Value = "Name"
objXL.Cells(1, 1).Font.Bold = TRUE
objXL.Cells(1, 2).Value = "Nickname"
objXL.Cells(1, 2).Font.Bold = TRUE
objXL.Cells(1, 3).Value = "Email Address"
objXL.Cells(1, 3).Font.Bold = TRUE

Dacount = 1

For each myContact in myContacts

if TypeName(myContact)= "RDOContactItem" Then

result =
utils.GetIDsFromNames(myContact.MAPIOBJECT,"{00062 004-0000-0000-C000-000000000046}",&H8085,false)
value = utils.HrGetOneProp(myContact.MAPIOBJECT, result)

if not isempty(value) then

Dacount = Dacount + 1
entryID = utils.HrArrayToString(value)

set RDOAddressEntry = RDOSession.GetAddressEntryFromID(
entryID)
smtpEmailAddress= RDOAddressEntry.SmtpAddress

objXL.Cells(Dacount, 1).value = myContact.FirstName+"
"+myContact.LastName
objXL.Cells(Dacount, 2).value = myContact.NickName

if mid(smtpEmailAddress,1,2) = "/o" then

foundSMTP = InStr(1,smtpEmailAddress,"SMTP:")
if foundSMTP 0 then
smtpEmailAddress=mid(smtpEmailAddress,foundSMTP+5)
objXL.Cells(Dacount, 3).value = smtpEmailAddress
else
foundSMTP = InStr(1,smtpEmailAddress,"Recipients/cn=")
smtpEmailAddress=mid(smtpEmailAddress,foundSMTP+14 )
set Recipient = utils.CreateRecipient(smtpEmailAddress,
0,0)

if Recipient.Resolved then
objXL.Cells(Dacount, 3).value =
Recipient.AddressEntry.SMTPAddress
else
smtpEmailAddress = "***Not avialable***"
objXL.Cells(Dacount, 3).value = smtpEmailAddress
objXL.Cells(Dacount, 3).Font.Bold = TRUE
end if
end if

else
if smtpEmailAddress = "" then
smtpEmailAddress = "***Not avialable***"
objXL.Cells(Dacount, 3).value = smtpEmailAddress
objXL.Cells(Dacount, 3).Font.Bold = TRUE
end if

objXL.Cells(Dacount, 3).value = smtpEmailAddress

end if

end if

end if
next

msgbox "Contact extraction done!",,"Contact extractor"