[OL-2010] trouver et effacer si il existe un contact en vba

trouver et effacer si il existe un contact en vba

Bonjour , j'ai dans ma base un carnet d'adresse avec un bouton qui me permet de créer un contact dans outlook (dossier contact base) et je voudrais avant la création d'un contact vérifier si il existe ou non mais je ne parviens pas a tester comme vrai ou faux si le contact est trouve ou non

La partie de code a cet effet:
Code:

1 2 3 4 5 6 7 8 Filtre = "[FileAs]= " & Me.Prenom & " " & Me.Nom Set oContact = myContactFolder.Items.Find(Filtre) If oContact = "" Then Else oContact.Delete End If
Si oContact n'est pas trouve ocontact est toujours vide (nothing) mais je n'arrive pas a le tester:
if isnull(ocontact) ne fonctionne pas.
Merci par avance de vos lumieres

Bonjour,

comme cela :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub testcaro()
 
Set myOlApp = CreateObject("Outlook.Application")
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myContactFolder = myNamespace.GetDefaultFolder(olFolderContacts)
Filtre = "[FileAs]= " & Me.Prenom & " " & Me.Nom
'Filtre = "[FileAs]= '" & Me.Nom & ", " & Me.Prenom & "'"
 
Set oContact = myContactFolder.items.Find(Filtre)
If oContact Is Nothing Then
MsgBox "pas trouvé"
Else
MsgBox "contact trouvé"
oContact.Delete
End If
End Sub

attention à ce que les contacts soient bien tous enregistrés dans le même format "Prenom Nom" ca peut être le contraire "nom prenom" ou "nom, prénom" etc..

attention .Find va te pointer le premier contact qui répond à ton filtre, si tu peux en avoir plusieurs, tu peux utiliser restrict

voici un exemple

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub TrouveEmailDansContact()
'by Oliv' 7/11/2007 pour Outlook 2003/2010
    Dim myOlApp As Outlook.Application
    Dim myNamespace As Outlook.NameSpace
    Dim myContacts As Outlook.items
    Dim myItems As Outlook.items
    Dim myItem As Object
    Email = InputBox("Quelle adresse cherchez vous ?", "Recherche dasns les contacts")
    Set myOlApp = Outlook.Application
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myContacts = myNamespace.GetDefaultFolder(olFolderContacts).items
    strWhere = "[Email1Address] ='" & Email & "' or [Email2Address] ='" & Email & "' or [Email3Address] ='" & Email & "'"
    Set myItems = myContacts.Restrict(strWhere)
    For Each myItem In myItems
        If (myItem.Class = olContact) Then
            MsgBox myItem.FullName & ":Email1 [" & myItem.Email1Address & "]" & vbCr & "Email2 [" & myItem.Email2Address & "]" & vbCr & "Email3 [" & myItem.Email2Address & "]"
        End If
    Next
if myItems.count=0 then msgbox "pas trouvé"
End Sub

Have a nice day too !!!
Ca marche impeccable ;merci beaucoup