从Outlook内部的消息添加联系人并忽略已存在的地址

Question

我有这个VBA代码，允许从Outlook选择的文件夹或选定的消息中添加联系人：

' 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

如果当前地址存在于地址簿中，我想转到下一个地址。

目前，我有这段代码：

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

但是如何忽略已经记录在地址簿中的地址？

Answer 1

如果地址簿中存在当前地址，则转到下一个地址。

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