2016-08-20 9 views
0

をアドレスを無視:は、私は、Outlook選択したフォルダまたは選択したメッセージから連絡先を追加することができ、このVBAコード持っている見通しの内部メッセージから連絡先を追加し、既に存在

' 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 

しかし、どのように、すでにアドレス帳に記録されたアドレスを無視しますか?

答えて

1

現在のアドレスがアドレス帳に存在する場合は、次のアドレスに移動します。

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

素晴らしい、感謝しています.... – beegees

関連する問題