RDV Outlook > Ajout de participant

Y compris Power BI, Power Query et toute autre question en lien avec Excel
L
Luuucie
Nouveau venu
Nouveau venu
Messages : 1
Inscrit le : 29 décembre 2017
Version d'Excel : 2016 FR

Message par Luuucie » 29 décembre 2017, 16:55

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
Avatar du membre
James007
Fanatique d'Excel
Fanatique d'Excel
Messages : 12'007
Appréciations reçues : 421
Inscrit le : 30 août 2014
Version d'Excel : 2007 EN

Message par James007 » 30 décembre 2017, 09:48

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 ...
A+

:)

Quand on n’a qu’un marteau, tous les problèmes deviennent des clous…
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message