Sub DeleteaContact()
Dim myOutlook As Outlook.Application
Dim myInformation As Namespace
Dim myContacts As Items
Dim myItems As ContactItem
Set myOutlook = CreateObject("Outlook.Application")
Set myInformation = myOutlook.GetNamespace("MAPI")
Set myContacts = myInformation.GetDefaultFolder(olFolderContacts).Items
For Each myItems In myContacts
If myItems.Email1Address = "j@yoursite.com" Then
myItems.Delete
End If
Next
End Sub
|