VBA that saves SMTP email instead of Active Directory in contacts

[hirrsson]

Hi,

I really need your help with a problem.

I'm using Outlook and it talks to exchange (via active directory).
My problem that I have is that outlook saves all the contacts, with a "link" to AD, instead of the contact information.
What I mean is:
Outlook saves a colleagues email address using the following format:
/o=COMPANY/ou=LOCATION/cn=Recipients/cn=USERNAME
What I want is to have the true SMTP address.

I took one night time to manually edit all my contacts (just 500 :banghead: ), and what I did was to copy all the SMTP addresses to notepad and then back to outlook.
That allowed me to export the contacts with their true SMTP address into a csv file.

Today I opened one contact and saw that outlook automatically regained the link to AD! DAMIT!


What I need is the following:
A VBA script (or program) that runs on all my contacts, extracting the SMTP address from all internal contacts and save it instead of the "AD link" (see above)

This so I can export all my contacts to a .csv file and then import it in my webmailer etc.

Would be really great to get your support!

Thanks
Mike

[klandreth]

I really new to VBA, but I had a similar problem until I stumbled upon this code via a Google search.

In the Outlook VBA Help, search for 'Resolve Display Name' and you should find something like this:

It works wonderfully for me; hope it will be of use to you.

Sub ResolveDisplayNameToSMTP() Dim oRecip As Outlook.Recipient Dim oEU As Outlook.ExchangeUser Dim oEDL As Outlook.ExchangeDistributionList Set oRecip = Application.Session.CreateRecipient("Dan Wilson") oRecip.Resolve If oRecip.Resolved Then Select Case oRecip.AddressEntry.AddressEntryUserType Case OlAddressEntryUserType.olExchangeUserAddressEntry Set oEU = oRecip.AddressEntry.GetExchangeUser If Not (oEU Is Nothing) Then Debug.Print oEU.PrimarySmtpAddress End If Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry Set oEDL = oRecip.AddressEntry.GetExchangeDistributionList If Not (oEDL Is Nothing) Then Debug.Print oEDL.PrimarySmtpAddress End If End Select End IfEnd Sub