Dim outobj As Outlook.Application
Dim objName As Outlook.NameSpace
Dim outappt As Outlook.AppointmentItem
Dim PST As Outlook.MAPIFolder, PSTcal As MAPIFolder
Set outobj = CreateObject("outlook.application")
Set objName = outobj.GetNamespace("MAPI")
Set PST = objName.Folders("Fichier de données Outlook")
Set PSTcal = PST.Folders("Calendrier")
Set PSTcal2 = PSTcal.Folders("jean")
Set outappt = PSTcal2.Items.Add
With outappt
.Start = moncreno
.Duration = 120 'Me!RVDurée
.Subject = moninterv
.Location = monlieu
.ReminderSet = False
.Body = moncomm
.Save
End With
' End If
' Libérez la variable objet Outlook.
Set outobj = Nothing
DoCmd.RunCommand acCmdSaveRecord
MsgBox " Rendez-vous ajouté ! "