CODEWITHSUNDEEP
vbaoutlook
David
David

Reputation: 447

Add contact from messages inside outlook and ignore address already present

I have this VBA code that allows to add contact from an Outlook selected folder or selected messages :

' 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 contact?", 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

I would like to go to the next address if the current address exists into the address book.

For the moment, I have this code :

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 contact?", vbQuestion + vbYesNo, "Contact Adder")
    If response = vbNo Then
    bContinue = False
    End If

But how to ignore the address already recorded in the address book ?

Upvotes: 0

Views: 184

Answers (1)

niton
niton

Reputation: 9199

To go to the next address if the current address exists in the address book.

If Not (oContact Is Nothing) Then
    bContinue = False
End If

Upvotes: 1

Related Questions