mollo777
Messages postés8Date d'inscriptionjeudi 3 février 2005StatutMembreDernière intervention25 septembre 2012
-
21 août 2005 à 09:57
arystoc
Messages postés41Date d'inscriptionmercredi 2 juillet 2003StatutMembreDernière intervention16 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.
arystoc
Messages postés41Date d'inscriptionmercredi 2 juillet 2003StatutMembreDernière intervention16 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