Créer un RVD sous outlook à partir d'une date sous Excel

GTmacrodeb

Expert
Bonjour à toute la communauté,

Je me tourne vers vous car j’ai besoin de conseils pour éditer un code VBA qui me permettrait de créer des RDV sous Outlook à partir de dates renseignées dans un classeur Excel.

Ci-dessous quelques explications sur le fichier et mes besoins :
Il s’agit d’un tableau de suivi des vérifications périodiques dans lequel une personne vient saisir une date de vérification (dans la colonne F). Dans la colonne G, la date de prochaine vérification est mise automatiquement à jour par formule.
Je souhaiterais qu’un message s’affiche automatiquement dès qu’une date est renseignée en colonne F afin de proposer à l’utilisateur de créer un RDV dans son calendrier Outlook. En cas de réponse positive, le RDV serait créé automatiquement en récupérant quelques infos du tableau pour renseigner les différents champs (Objet, Lieu…).
Je cherche également à pouvoir paramétrer la période du rappel à 15 jours avant le RDV.

Vous trouverez ci-dessous un début de code trouvé sur le net et que j’ai essayé d’adapter mais qui ne fonctionne pas…
Code:
Sub AjoutRDV()
  Dim DLig As Long, Lig As Long
  Dim OutObj As Outlook.Application
  Dim OutAppt As Outlook.AppointmentItem
  Dim DateRdv As Date, FlgRdv As Boolean
  Dim MyCalendar As Outlook.Items
  Dim OutlMapi As Outlook.Namespace
  Dim OutlFolder As Outlook.MAPIFolder
  Dim MyItem As Outlook.AppointmentItem
  Dim myOlApp As New Outlook.Application
  Dim MyFolder As Outlook.Items
  Dim objOutlook As New Outlook.Application
 
  ' Créer une instance d'Outlook
  Set OutObj = CreateObject("outlook.application")
  ' Avec la feuille
  With Sheets("GENERAL")
    DLig = .Range("G" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 4 To DLig
      ' Vérifier si pas déjà fait
      If .Range("G" & Lig) <> "" Then
      Else
        FlgRdv = True
      End If
      ' Si le FLAG est à vrai on créé le RDV
      If FlgRdv Then
       'création du rdv

 
    'choix du calendrier
     Set OutAppt = OutObj.CreateItem(olAppointmentItem)
 
 
        DateRdv = Range("G" & Lig) 'date du rdv, ici prend la colonne G
        Set OutAppt = OutObj.CreateItem(olAppointmentItem)
        With OutAppt
          .Subject = "Planification contrôle " & Sheets("GENERAL").Range("B" & Lig) & Sheets("GENERAL").Range("C" & Lig) & "- n° interne : " & Sheets("GENERAL").Range("E" & Lig)  'sujet du rdv
          .Start = DateRdv & " 08:00 " 'Début du rendez-vous
          .Duration = 60 'durée en minute du rdv
          .Body = Range("F" & Lig)
          .ReminderSet = True 'présence ou non d'un rappel (True/False)
          .Save
        End With
        ' Créer le commentaire et inscrire Oui
        On Error Resume Next
        .Range("" & Lig) = "Rdv créé"
        On Error GoTo 0
      End If
    Next Lig
  End With
  Set OutAppt = Nothing
     Set objOutlook = Nothing
 
End Sub

Je suis donc à votre écoute afin de me guider dans cet apprentissage.

En vous remerciant par avance.


GTmacrodeb
 

Thore

Grand Maître
tu peu regarder cela :

https://www.developpez.net/forums/d1420010/logiciels/microsoft-office/excel/macros-vba-excel/exportez-date-excel-sous-forme-rendez-outlook-2010-a/
 

GTmacrodeb

Expert
Il s'agit en effet du code dont je suis parti pour tenter de l'adapter à mon besoin.

Cependant mon niveau en langage VB ne me permet pas de l'exploiter à bon escient, d'où mes questions.
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 128
Messages
6 717 841
Membres
1 586 372
Dernier membre
Meeithot
Partager cette page
Haut