Sub AjoutRDVCalendrier()
'déclaration des variables
Dim oOutlook As Outlook.Application
Dim oAppointment As Outlook.AppointmentItem
Dim namespaceOutlook As Outlook.Namespace
Dim DossierCalendrier As Outlook.MAPIFolder
Dim myTasks As Outlook.folder
Dim myFolder As Outlook.folder
'gestion d'erreurs
On Error GoTo Err_Execution
'on crée ensuite les objets
Set oOutlook = CreateObject("Outlook.Application")
Set namespaceOutlook = oOutlook.GetNamespace("MAPI")
Set myTasks = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
Set myFolder = myTasks.Folders(1)
Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
'on crée un nouveau rendez-vous
Set oAppointment = DossierCalendrier.items.Add
'on renseigne ensuite les principaux paramètres
With oAppointment
.Start = "30/01/2020 12:00:00"
.Duration = 180 'durée de rdv, en minutes
.Subject = "Réunion avec Mark" 'Sujet du rdv
.Body = "" 'corps du texte de la réunion
.Location = "Timhotel Paris" 'Lieu du rdv
'on sauvegarde et ferme
.Save
.Close (olSave)
End With
Set DossierCalendrier = myFolder
'on crée un nouveau rendez-vous
Set oAppointment = DossierCalendrier.items.Add
'on renseigne ensuite les principaux paramètres
With oAppointment
.Start = "30/01/2020 12:00:00"
.Duration = 180 'durée de rdv, en minutes
.Subject = "Réunion avec Mark " 'Sujet du rdv
.Body = "" 'corps du texte de la réunion
.Location = "Timhotel Paris" 'Lieu du rdv
'on sauvegarde et ferme
.Save
.Close (olSave)
End With
'Libération des variables.
Set oAppointment = Nothing
Set oOutlook = Nothing
Fin_Execution:
Exit Sub
Err_Execution:
MsgBox Err.Description, vbExclamation
Resume Fin_Execution
End Sub