How to Create Macro in Visual Basic to add Contacts from Personal Folder

Status
Not open for further replies.

mickash

Member
Outlook version
Email Account
POP3
:confused:Help! My contact list on a prior system was deleted. I have imported all of my emails into my new Microsoft Outlook 2003 but going through all the emails individually to add contacts is horrible when you have thousands of emails. Does anyone have the micro basic code to set up a macro to add contacts from the personal favorite folder?

i.e. click on a message, right address, click on add to contact list, then click on save and close (when outlook creates contact)?

I would really appreciate all the help I can get. Visual Basic looks like greek!
 

Forum Admin

Senior Member
there are addins you could use - at least i think they might work as you need to use something you can run on mail in your folders.

Here is a code sample that adds them when replying - http://www.outlookcode.com/d/code/autoaddrecip.htm - you'd need to change it to do it on all messages. (I'll check around and see if anyone has sample code that better meets your needs.)

We have a long list of tools here: http://www.slipstick.com/contacts/addauto.asp - but I'm not sure if any can go through folders and create contacts. (the custom action sample would be prefer using run rules now but it need compiled.)
 

Forum Admin

Senior Member
Here you go - compliments of at http://www.slovaktech.com



The macro will work in any selected folder on all selected items in that folder.



Any selected mail items will be harvested. Because I wanted to only use the OOM and you didn’t say if this was 2007 or later only, I didn’t use the MAPI properties for SentOnBehalfOf* other than for name. So the email addresses may not be accurate (for example mails sent to mailing lists will show the list address, not the actual sender's address.)



If this were 2007 or later code only I’d use PropertyAccessor to pick up the PR_SENT_REPRESENTING_ADDRTYPE and PR_SENT_REPRESENTING_EMAIL_ADDRESS properties instead of using SenderEmailAddress and SenderEmailAddressType.



A text file of this code is here: http://www.slipstick.com/contacts/_oft/save-addresses-to-contacts.txt


Code:

 
 
' The AddAddressesToContacts procedure can go in any Module
 
 
' Select the mail folder and any items to add to contacts, then run the macro
 
 
Public Sub AddAddressesToContacts()
 
 
Dim folContacts As Outlook.MAPIFolder
 
 
Dim colItems As Outlook.Items
 
 
Dim oContact As Outlook.ContactItem
 
 
Dim oMail As Outlook.MailItem
 
 
Dim obj As Object
 
 
Dim oNS As Outlook.NameSpace

 
 
Dim response As VbMsgBoxResult

 
 
Dim bContinue As Boolean

 
 
Dim sSenderName As String

 
 
On Error Resume Next

 
 
Set oNS = Application.GetNamespace("MAPI")
 
 
Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
 
 
Set colItems = folContacts.Items

 
 
For Each obj In Application.ActiveExplorer.Selection
 
 
If obj.Class = olMail Then
 
 
Set oContact = Nothing

 
 
bContinue = True
 
 
sSenderName = ""

 
 
Set oMail = obj

 
 
sSenderName = oMail.SentOnBehalfOfName
 
 
If sSenderName = "" Then
 
 
sSenderName = oMail.SenderName
 
 
End If

 
 
Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")

 
 
If Not (oContact Is Nothing) Then
 
 
response = MsgBox("This appears to be an existing contact: " & sSenderName & ". Do you still want to add it as a new conact?", vbQuestion + vbYesNo, "Contact Adder")
 
 
If response = vbNo Then
 
 
bContinue = False
 
 
End If
 
 
End If

 
 
If bContinue Then
 
 
Set oContact = colItems.Add(olContactItem)
 
 
With oContact
 
 
> Body = oMail.Subject

 
 
> Email1Address = oMail.SenderEmailAddress
 
 
> Email1DisplayName = sSenderName
 
 
> Email1AddressType = oMail.SenderEmailType

 
 
> FullName = oMail.SenderName

 
 
> Save
 
 
End With
 
 
End If
 
 
End If
 
 
Next

 
 
Set folContacts = Nothing
 
 
Set colItems = Nothing
 
 
Set oContact = Nothing
 
 
Set oMail = Nothing
 
 
Set obj = Nothing
 
 
Set oNS = Nothing
 
 
End Sub
 
Status
Not open for further replies.
Top