OUTLOOK : ENVOI DE MAIL ET AJOUT, MODIFICATION ET SUPRRESION DES RENDEZ-VOUS DANS LE CALENDRIER

'Envoie de mail

Dim objOutlook as New Outlook.Application
Dim objOutlookMsg as Outlook.MailItem

Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
       .To = "Adresse@Destinataire"
       .Subject = "Objet du message"
       .Body = "Texte du message"
       .Send
End With
Set objOutlookMsg = Nothing

'Ajout d'un rdv au calendrier

Dim objOutlook as New Outlook.Application
Dim objOutlookAppt as Outlook.AppointmentItem

Set objOutlookAppt = objOutlook.CreateItem(olAppointmentItem)
With objOutlookAppt
       .Start = "jj/mm/aaaa hh:mm"
       .Duration = x       'En minute
       .Subject = "Description du rendez-vous"
       .Save
End With

'Modifier/Supprimer un rdv du calendrier

Dim objOutlook as New Outlook.Application
Dim objOutlookAppt as Outlook.AppointmentItem
Dim objOutlookCalendar as Outlook.Items
Dim objOutlookNameSpace as Outlook.NameSpace
Dim DateDebut as String, DateFin as String

Set objOutlookNameSpace =  objOutlook.GetNameSpace("MAPI")
Set objOutlookCalendar = objOutlookNameSpace.GetDefaultFolder(olFolderCalendar).Items
objOutlookCalendar.Sort "[Start]"
objOutlookCalendar.IncludeReccurrences = True

DateDebut = "jj/mm/aaaa hh:mm"
DateFin = "jj/mm/aaaa hh:mm"

Set objOutlookAppt = objOutlookCalendar.Find("[Start] >= " " " & DateDebut & " " " and    [Start] <= " " " & DateFin & " " " ")
While TypeName(objOutlookAppt) <> "Nothing"
       If objOutlookAppt.Subject = "RDV recherché pour etre modifié" then
              objOutlookAppt.Subject = "Nouveau sujet"
              objOutlookAppt.Save
              Exit Sub
       End If

       If objOutlookAppt.Subject = "RDV recherché pour supprimé" then
              objOutlookAppt.Delete
              Exit Sub
       End If 
       Set objOutlookAppt = objOutlookCalendar.FindNext
Wend