Google Answers Logo
View Question
 
Q: Automatic adding of Contacts from existing sent emails in Outlook 2002 ( Answered 5 out of 5 stars,   0 Comments )
Question  
Subject: Automatic adding of Contacts from existing sent emails in Outlook 2002
Category: Computers > Software
Asked by: bigjosh-ga
List Price: $25.00
Posted: 06 Jan 2003 14:41 PST
Expires: 05 Feb 2003 14:41 PST
Question ID: 138453
I am looking for an easy way to add a Contact in Outlook 2002 for
every address that I've ever sent an email to. This way, I will be
able to use Outlook's Autocomplete to type these email addresess for
me and I won't have to remember them.

I have all my sent emails in my Sent Items folder. There are thousands
of them, so any usefull soultion must not require any manual per-item
action.

It would also like the added Contacts to have the full name of the
person if that name was part of the email address. Example: If I sent
an email to "Brendan Martin [bmartin@josh.com]", I'd like the contact
to be added with the name "Martin, Brendan" and an email address of
"bmartin@josh.com".

Please try the answer before posting it to make sure it actually
works.
Answer  
Subject: Re: Automatic adding of Contacts from existing sent emails in Outlook 2002
Answered By: cerebrate-ga on 06 Jan 2003 18:28 PST
Rated:5 out of 5 stars
 
Dear bigjosh-ga,

Thank you for the interesting question. I've coded up a quick macro in
VBA which should do nicely for you, and, as requested, I've tested it
here (against Outlook 2002, SP2).

Depending on your settings, you may need to lower your Outlook Macro
Security settings, or sign the project you create to contain this, in
order for this to run for you. Also, when you run it, you will receive
a warning from Outlook that a program is trying to access your address
book - this is normal; check the box to allow it access for ten
minutes.

To set it up, open "Tools"/"Macro"/"Visual Basic Editor" and insert a
new module into the project. Paste the code below into that module:

Dim ns As NameSpace
Dim contacts As MAPIFolder
Dim sentItems As MAPIFolder
Dim sentII As Items
Dim current As MailItem
Dim ciRecip As Recipients
Dim ri As Long
Dim cirName As String
Dim cirAddress As String
Dim newContact As ContactItem
Dim dupes As New Dictionary
Dim processed As Long

Sub Main()
    ' Get the namespace for the current Outlook session
    Set ns = Application.GetNamespace("MAPI")
    
    ' Get the contacts and sent items folders
    Set contacts = ns.GetDefaultFolder(olFolderContacts)
    Set sentItems = ns.GetDefaultFolder(olFolderSentMail)
    
    ' Iterate through every item in the Sent Items folder
    Set sentII = sentItems.Items
    Set current = sentII.GetFirst
    processed = 0
    
    Do
    
    ' Extract the relevant information from the MailItem
    ' Namely, the recipients from each
    Set ciRecip = current.Recipients
    For ri = 1 To ciRecip.Count
        ' Extract the information
        With ciRecip.Item(ri)
            cirName = .Name
            cirAddress = .Address
        End With
        
        ' Strip off leading and trailing apostrophes from the full
name
        If Left$(cirName, 1) = "'" Then
            cirName = Right$(cirName, Len(cirName) - 1)
        End If
        
        If Right$(cirName, 1) = "'" Then
            cirName = Left$(cirName, Len(cirName) - 1)
        End If
        
        ' Check if the contact already exists
        If dupes.Exists(cirAddress) Then
            Exit For
        End If
        
        ' Create the contact
        Set newContact = Application.CreateItem(olContactItem)
        With newContact
            .FullName = cirName
            .Email1Address = cirAddress
            .Save
        End With
        
        ' Add the address to the dupes collection
        dupes.Add cirAddress, "exists"
    Next
    
    ' Get the next item; if it is nothing, fall through the loop.
    processed = processed + 1
    Set current = sentII.GetNext
    
    Loop Until current Is Nothing
    
    ' We've iterated through 'em all, now
    Call MsgBox("Items processed: " & processed, vbOKOnly, "Import
Complete")
End Sub

You will also need to add "Microsoft Scripting Runtime" to the
referenced modules ("Tools"/"References...").

When you run this macro, it will add every unique e-mail address it
finds in the recipients of messages in your "Sent Items" folder as a
new contact, with the matching display name attached as the full name
of the contact. When it's completed iterating through your entire
"Sent Items" folder, it displays a message box with the number of
messages it has processed as a check for you.

If you run into any problems implementing this, or if this answer
isn't quite what you're looking for, please feel free to request a
clarification,
    
cerebrate-ga

Search strategy:

Developed for the customer.
bigjosh-ga rated this answer:5 out of 5 stars and gave an additional tip of: $25.00
Excelent answer. I did not even think of using VBA, but it solves the
problem handily. Thanks.

Comments  
There are no comments at this time.

Important Disclaimer: Answers and comments provided on Google Answers are general information, and are not intended to substitute for informed professional medical, psychiatric, psychological, tax, legal, investment, accounting, or other professional advice. Google does not endorse, and expressly disclaims liability for any product, manufacturer, distributor, service or service provider mentioned or any opinion expressed in answers or comments. Please read carefully the Google Answers Terms of Service.

If you feel that you have found inappropriate content, please let us know by emailing us at answers-support@google.com with the question ID listed above. Thank you.
Search Google Answers for
Google Answers  


Google Home - Answers FAQ - Terms of Service - Privacy Policy