Problems with code

G

Gustavo Strabeli

Hello!

I'm using below code in order to have Outlook adding email addresses to my
contacts folder.
So here's the problem: adresses are being added to my contacts however it's
inserting quotes before and after the address.
I don't know nothing about VBA, but analysing the code I deleted the Chr(34)
from the code and this problem was solved, however another problem was
raised: now all my contacts are being duplicated.
Do you know how to fix that? I mean, delete the quotes and don't have the
contacts duplicated?

Thanks a lot,

Gustavo

The code:

Sub AddRecipToContacts(objMail As Outlook.MailItem)
Dim strFind As String
Dim strAddress As String
Dim objNS As Outlook.NameSpace
Dim colContacts As Outlook.Items
Dim objContact As Outlook.ContactItem
Dim objRecip As Outlook.Recipient
Dim i As Integer
On Error Resume Next

' get Contacts folder and its Items collection
Set objNS = Application.GetNamespace("MAPI")
Set colContacts = _
objNS.GetDefaultFolder(olFolderContacts).Items

' process message recipients
For Each objRecip In objMail.Recipients

' check to see if the recip is already in Contacts
strAddress = AddQuote(objRecip.Address)
For i = 1 To 3
strFind = "[Email" & i & "Address] = " & _
strAddress
Set objContact = colContacts.Find(strFind)
If Not objContact Is Nothing Then
Exit For
End If
Next

' if not, add it
If objContact Is Nothing Then
Set objContact = _
Application.CreateItem(olContactItem)
With objContact
.FullName = objRecip.Name
.Email1Address = strAddress
.Save
End With
End If
Set objContact = Nothing
Next

Set objNS = Nothing
Set objContact = Nothing
Set colContacts = Nothing
End Sub

Function AddQuote(MyText) As String
AddQuote = Chr(34) & MyText & Chr(34)
End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top