Discussion :

[stephadm]

Bonjour au forum,

Je souhaite tester depuis mon userform en cliquant sur bouton valider

- si le client est existant dans la liste des contacts outlook, il m'affiche un message
- si non il affiche un autre message et créer le nouveau contact dans outlook.
Voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub controleLastName_contactsOutlook()
    Dim olApp As New Outlook.Application
    Dim Cible As Outlook.ContactItem
    Dim dossierContacts As Outlook.MAPIFolder
    Dim leNom As String
    Dim leTel As String
 
    leNom = nom.Value
    leTel = TextBox2.Value
 
    Set olApp = New Outlook.Application
    Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
 
    Set Cible = dossierContacts.Items.Find("?[FullName] = '" & leNom & "'" And [HomeTelephoneNumber] = "'" & leTel & "'")
    If Not Cible Is Nothing Then
        MsgBox "Le contact existe déjà dans Ms Outlook"
    Else
        MsgBox "Le contact n'existe pas et donc va être ajouter"
        ajouterContactOutlook
    End If
End Sub

Ne fonctionne pas, affichage du message d'erreur 13' incompatibilité de type" et souligne en jaune

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    Set Cible = dossierContacts.Items.Find("?[FullName] = '" & leNom & "'" And [HomeTelephoneNumber] = "'" & leTel & "'")

Pouvez-vous m'aider ?

Merci

Stephanie

[BlueMonkey]

Bonsoir,

Pour ne pas avoir de problème dans la mise en forme de la propriété FullName, je conseil de séparer Nom et Prénom.
Attention également à la mise en forme du numéro de téléphone.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub controleLastName_contactsOutlook()
    Dim olApp As New Outlook.Application
    Dim Cible As Outlook.ContactItem
    Dim dossierContacts As Outlook.MAPIFolder
    Dim leNom As String
    Dim lePrenom As String
    Dim leTel As String
 
    leNom = nom.Value
    'A FAIRE : lePrenom  = prenom.value
    leTel = TextBox2.Value
 
    Set olApp = New Outlook.Application
    Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
 
    Set Cible = dossierContacts.Items.Find("[LastName] = '" & leNom & "' and [FirstName] = '" & lePrenom & "'")
    If Not Cible Is Nothing Then
        If Cible.HomeTelephoneNumber = leTel Then
            MsgBox "Le contact existe déjà dans Ms Outlook"
        End If
    Else
            MsgBox "Le contact n'existe pas et donc va être ajouter"
    End If
End Sub

[stephadm]

Bonjour BlueMonkey et au forum

Je nom et le prenom se trouve dans la meme textbox (le pourquoi du "FullName") , et je préfère tel quel car je suis obligé de tout refaire le programme.

Peux-t-on faire le control uniquement sur le nom et le téléphone ?

Concernant le format du téléphone, j'utilise ceci : 00.00.00.00.00

Merci

Stéphanie

[BlueMonkey]

Bonjour,

Je nom et le prenom se trouve dans la meme textbox (le pourquoi du "FullName") , et je préfère tel quel car je suis obligé de tout refaire le programme.

Comme indiqué l'utilisation de la clé FullName me semble risqué, parce que la mise en forme est assez particulière.
(faire un test de recherche manuel avec Prénom et nom, puis utiliser le débugger sur Cible pour se faire une idée de la mise en forme).

Ensuite la ligne 16 du code précédent pourra être remplacé par :
Set Cible = dossierContacts.Items.Find("[FullName] = '" & leNom & "'").

[stephadm]

bonjour BlueMonkey, et au forum

Désolé de ne pas avoir repondu avant j'étais sur mon autre projet.

Maintenant tout va jusqu'à la fin sauf que, la macro m'annonce toujours que "Le contact n'existe pas". Dans le code j'ai ciblé directment sur l'email pour vérifier avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set Cible = dossierContacts.Items.Find("[Email1Address] = '" & leMail & "'")

Comment faire, j'ai l'impression que ça ne fonctionne pas, j'ai le même problème avec les RDV.

Pour info

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub RDVOutlookExistant()
Dim OutlApp As New Outlook.Application
Dim OutlMapi As Outlook.Namespace
Dim OutlFolder As Outlook.MAPIFolder
Dim OutlAppointment As Outlook.AppointmentItem
Dim OutlItems As Outlook.Items
Dim DateDebut As String
 
DateDebut = TextBox1.Value & " " & TextBox4.Value
 
Set OutlMapi = OutlApp.GetNamespace("MAPI")
Set OutlFolder = OutlMapi.GetDefaultFolder(olFolderCalendar)
Set OutlItems = OutlFolder.Items
 
On Error Resume Next
Set OutlAppointment = OutlItems.Find("[Start] = '" & DateDebut & "'")
On Error GoTo 0
 
If OutlAppointment Is Nothing Then
    UserForm6
    NouveauRDV_Calendrier
Else
    MsgBox "Un Rdv déja prévu à cette date:" & vbCrLf & _
        OutlAppointment.Subject
End If
End Sub

Avez-vous une idée ?

Merci

Stephanie

[BlueMonkey]

Bonsoir,

la macro m'annonce toujours que "Le contact n'existe pas". Dans le code j'ai ciblé directment sur l'email pour vérifier

Etrange. Sous ma version d'Excel XLS2003 ce code adapté pour une recherche par adresse email fonctionne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub controle_contactsOutlook()
    Dim olApp As New Outlook.Application
    Dim Cible As Outlook.ContactItem
    Dim dossierContacts As Outlook.MAPIFolder
    Dim adresseEmail As String
 
    adresseEmail = email.Value
 
    Set olApp = New Outlook.Application
    Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
    Set Cible = dossierContacts.Items.Find("[Email1Address] = '" & adresseEmail & "'")
    If Not Cible Is Nothing Then
        MsgBox "Le contact existe déjà dans Ms Outlook"
    Else
        MsgBox "Le contact n'existe pas et donc va être ajouter"
    End If
End Sub

Pour le test de rendez-vous essayer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub controleRendezVous_contactsOutlook()
    Dim olApp As New Outlook.Application
    Dim Cible As Outlook.AppointmentItem
    Dim dossierContacts As Outlook.MAPIFolder
 
    Set olApp = New Outlook.Application
    Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
    Dim dateRecherche As Date
    Dim heureRecherche As String
    d = DateValue("21/04/2012")
    heureRecherche = "8:00"
    Set Cible = dossierContacts.Items.Find("[Start] = '" & d & "'")
    If Not Cible Is Nothing Then
        Dim t As Date
        If TimeValue(Cible.Start) = TimeValue(heureRecherche) Then
            MsgBox "Il y a déjà un rendez vous dans Ms Outlook"
        End If
    Else
        MsgBox "Pas de rendez-vous à cette date."
    End If
End Sub