1. Accueil
  2. Forum Codes-Sources
  3. Visual Basic
Sujet Précédent Sujet Suivant

ASSOCIER UN CONTACT A UN RDV OUTLOOK

mollo777 Messages postés 8 Date d'inscription jeudi 3 février 2005 Statut Membre Dernière intervention 25 septembre 2012 - 21 août 2005 à 09:57
arystoc Messages postés 41 Date d'inscription mercredi 2 juillet 2003 Statut Membre Dernière intervention 16 juillet 2006 - 21 août 2005 à 11:00
Salut à tous!

Je souhaiterai savoir s'il est possible d'associer un contact (existant dans la liste des contacts ou pas), à un RDV Outlook.
Si le contact existe, j'arrive à faire une rechercher dans la liste des contacts et l'ajouter en "link", mais dans le cas ou il n'existe pas , je ne sais pas comment associer juste son nom, sans le créer dans le liste des contact.

Merci à tous.

1 réponse

Réponse 1 / 1
arystoc Messages postés 41 Date d'inscription mercredi 2 juillet 2003 Statut Membre Dernière intervention 16 juillet 2006
21 août 2005 à 11:00
Salut!!

Bien sûr que tu peux ajouter un contact à OutLook tou en verifiant au préalable si ce contact existe.
Voici ce que j'ai fait et ça marche:

Public Sub AjouterUnContact(Email As String, Nom As String, Prenom As String)
Dim DocOutLook As Outlook.Application
Dim MonCotact As ContactItem

'crée une instance de Outlook
Set DocOutLook = CreateObject("Outlook.Application")
'Vérifie l'existence du contact
If SiContactExiste(Email, Nom, Prenom) = True Then
MsgBox "Ce contact existe déjà dans votre carnet d'adresse OutLook"
Else
'crée un élément pour le dossier.
'remplit l'élément de valeurs
'sauvegarde l'élément
Set MonCotact = DocOutLook.CreateItem(olContactItem)
With MonCotact
.FirstName = Prenom
.LastName = Nom
.Email1Address = Email
.Save
End With
End If
End Sub



private Function SiContactExiste(Email As String, Nom As String, Prenom As String) As Boolean
Dim DocumentOutlook As Outlook.Application
Dim NomEspace As NameSpace
Dim MesContacts As Items
Dim MesElements As ContactItem

Set DocumentOutlook = CreateObject("Outlook.Application")
Set NomEspace = DocumentOutlook.GetNamespace("MAPI")
Set MesContacts = NomEspace.GetDefaultFolder(olFolderContacts).Items
SiContactExiste = False
For Each MesElements In MesContacts
Debug.Print MesElements.FirstName, MesElements.LastName, MesElements.Email1Address
If MesElements.Email1Address Email and MesElements.FirstName Prenom and MesElements.LastName = Nom Then
SiContactExiste = True
End If
Next
End Function
0
Rejoignez-nous