2016-08-20 2 views
0

Ich habe diesen VBA-Code, den Kontakt von einem Outlook ausgewählten Ordnern oder ausgewählte Nachrichten hinzufügen kann:Kontakt von Nachrichten in Outlook und ignoriert Adresse bereits

' 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 

Ich mag würde auf die nächste Adresse gehen, wenn Die aktuelle Adresse existiert im Adressbuch.

Im Moment habe ich diesen 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 

Aber wie die Adresse ignorieren bereits im Adressbuch gespeichert?

Antwort

1

Um zur nächsten Adresse zu gehen, wenn die aktuelle Adresse im Adressbuch existiert.

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

funktioniert super, danke .... – beegees

Verwandte Themen