RDV Outlook > Ajout de participant
L
Bonjour,
Au fil des forums, j'ai réussi à créer un outil me permettant de créer des rdv directement dans Outlook.
Je suis maintenant coincée à la dernière étape.
A la création du rdv dans le calendrier de la personne utilisant le fichier, je souhaiterais que ce rdv s'inscrive à l'identique dans le calendrier d'autres participants.
Idéalement, le rdv s'ajoute tout seul dans le calendrier sans envoyer d'invitation.
Voici mon code à date.
A noter pour le RecipientAdd j'ai tenté les 2 syntaxes suivantes :
.Recipients.Add "prenom.nom@email.fr"
.Recipients.Add "prenom.nom"
D'avance merci pour votre aide !
Lucie
Sub AjoutRV()
Dim DLig As Long, Lig As Long
Dim OutObj As Outlook.Application
Dim OutAppt As Outlook.AppointmentItem
Dim DateRdv As Date, FlgRdv As Boolean
' Créer une instance d'Outlook
Set OutObj = CreateObject("outlook.application")
' Avec la feuille
With Sheets("Suivi")
DLig = .Range("A" & Rows.Count).End(xlUp).Row
' Pour chaque ligne
For Lig = 2 To DLig
' Si une date de relance existe
If .Range("B" & Lig) <> "" Then
' Si un RDV n'a pas déjà été créé
If .Range("D" & Lig) <> "" Then
' Si le commentaire à changé
If .Range("D" & Lig).Comment.Text <> .Range("C" & Lig).Value Then
FlgRdv = True
Else
' Sinon le commentaire n'a pas changé = pas de RDV
FlgRdv = False
End If
Else
' Sinon, pas de RDV déjà créé
FlgRdv = True
End If
Else
' Sinon, pas de date de relance
FlgRdv = False
End If
' Si le FLAG est à vrai on créé le RDV
If FlgRdv Then
DateRdv = Range("B" & Lig)
Set OutAppt = OutObj.CreateItem(olAppointmentItem)
With OutAppt
.Subject = "Store Loc : " & Sheets("Suivi").Range("A" & Lig) & " > " & Sheets("Suivi").Range("C" & Lig)
.Start = DateRdv & " 08:00"
.Recipients.Add "prenom.nom@email.fr"
.Duration = 60
.ReminderSet = True
.Send
.Save
End With
' Créer le commentaire et inscrire Oui
On Error Resume Next
.Range("D" & Lig).Comment.Delete
.Range("D" & Lig).AddComment Text:=.Range("C" & Lig).Value
.Range("D" & Lig) = "Oui"
On Error GoTo 0
End If
Next Lig
End With
Set OutAppt = Nothing
End Sub
Bonjour,
Tu devrais insérer le type de réunion dans ton code
With OutAppt
' Définir type de Réunion
.MeetingStatus = olMeeting
.Subject = ...
avant d'utiliser
.Recipients.Add
En espérant que cela t'aide ...