How to extract email addresses from TO or CC line of a particular email

[Ivan]

Hello

I'm using Outlook 2007 on Exchange and I'm having an email with a huge
amount of recipiens in the To and Co lines and I woul like to collect these
addresses into one of the subfolder of my Contacts folder.

OK, I can copy one email address at a time if I select only one address,
then pick out the "Add to Outlook Contacts" command from the mouse right
click menu. Evidently is this procedure more than retardatory.

If I select two or more addresses from any of both lines, then there isn't
any such "Add to Outlook Contacts" command on the content menu and I can
only copy the selected addresses to clipboard. As I can see nad understand
only the display name parts of the addresses are copied to cipboard and
these data are without real address not useful for me.

I'm sure that it should be some way to do this with VBA code. Could anybody
help me with a piece of code or a hint?

Ivan

 

[Ken Slovak - [MVP - Outlook]]

Get the Recipients collection of the mail item and iterate that collection.
You can harvest whatever information you want from each Recipient (whatever
is available on that object).

When adding contacts using code you will not get any warning dialogs if you
try to add a duplicate contact. So any code must search in the Contacts to
see if such a contact already exists. How you determine a duplicate is up to
you. Names can be slightly different (Richard, Rich, Ricky) and so on, so
you have to account for that.

It's somewhat more complicated than it sounds like it would be.

 

[Ivan]

Thank you Ken,

I play with some VBA code and below is a program for extracting the display
names and the addresses from all the emails od the specific outlook folder.
The results are in the Immediate window of MVB and an user can easily change
that part of the code:

Sub ExtractRecipientsFromEmail()
Dim OlApp As Outlook.Application
Dim MailObject As Object
Dim RecipientObject As Object
Dim Email As String
Dim NS As NameSpace
Dim Folder As MAPIFolder
Set OlApp = CreateObject("Outlook.Application")
Set NS = ThisOutlookSession.Session
Set Folder = NS.PickFolder
For Each MailObject In Folder.Items
If MailObject.Class = olMail Then
For Each RecipientObject In MailObject.Recipients
If RecipientObject.Address Like "*@*" Then
Debug.Print RecipientObject.Name, RecipientObject.Address
End If
Next
End If
Next
Set OlApp = Nothing
Set MailObject = Nothing
Set RecipientObject = Nothing
End Sub


Ivan