Création rdv Outlook

**BenITK** · 15/10/2018, 15h46

Bonjour à tous,

Sur une appli en cours de développement j'ai besoin de créer des rdv Outlook incluant des participants, avec rappel, pour les informer qu'ils ont des actions à faire à une heure précise.
Jusque là rien de bien sorcier, le rdv est bien créé, les participants ajoutés, malheureusement le rdv ne leur arrive jamais et n'apparait pas sur leur calendrier. Il n'apparait que sur l'Outlook du compte ayant servi à envoyé l'invite. Sur cet Outlook, quand on ouvre l'invite, on voit bien les participants en obligatoires, mais aucun créneau de bleuté sur leur calendrier.

J'avoue être un peu paumé. Y'a un truc qui doit manquer dans mon code mais je sais pas quoi.

Voici le code utilisé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub RdvOutlook(NRacine As String, Etuve As String, DateL As Date)
 
        On Error GoTo AddAppt_Err
 
        Dim outobj As New outlook.Application
        Dim outappt As outlook.AppointmentItem = outobj.CreateItem(outlook.OlItemType.olAppointmentItem)
 
 
        With outappt
            .Start = DateL
            .Duration = 30        ' En minute 
            .RequiredAttendees = "adresse.mail@internet.com"
            .Recipients.Add("adresse.mail@internet.com")
            .Recipients.ResolveAll()
            .ResponseRequested = True
            .Subject = "ITK Géloses-Lecture " & NRacine
            .Body = "Lecture des réactifs à faire"
            .Location = Etuve
            .AllDayEvent = False     ' Toute la journée oui/non
            .ReminderMinutesBeforeStart = 30
            .ReminderSet = True   ' S'il y a un rappel
            .Send()
            .Save()
        End With
        outobj = Nothing  ' Retire de la mémoire les objets créer
 
        Exit Sub
 
AddAppt_Err:
        MsgBox("Error " & Err.Number & vbCrLf & Err.Description)
        Exit Sub