Création rappel Outlook

juyce

XLDnaute Nouveau
Bonjour,

Je souhaite créer un rappel sur outlook lié à un fichier Excel. Je m'explique, jai un fichier Excel qui reprend l'ensemble des contrats de frais récurrents du groupe (ex: poste, entretien des l'immeubles, license infomatique,...) avec notamment la date de contrat ,la date de fin de contrat et les modalités de reconduction du contrat.

Dans l'idéal, il faudrait créer une alerte sur Outlook pour ne pas louper la date d'anniversaire de fin de contrat afin de le renouveller avant... Ce rappel devrait pouvoir s'afficher 3 mois avant la date de fin de contrat... Il est possible d'ajouter une colone avec la date à laquelle doit s'afficher l'alerte, utile pour pouboir gérer les différents délais de rupture ou reconduction de contrat...

Je vous joins un fichier type.

Merci de vos retours, dans l'attente de vous lie et d'en apprendre un peu plus !
 

Pièces jointes

  • SITE A.xlsx
    9.7 KB · Affichages: 133

BrunoM45

XLDnaute Barbatruc
Re : Création rappel Outlook

Salut Juyce,

En créant une feuilles "Params" pour les paramètres de rappel Outllok et en
ajoutant ce code à ton fichier, avec un bouton sur la feuille
VB:
' Ajouter un nouveau rendez-vous.
Sub RappelOutlook()
  ' Il est nécessaire de définir la référence : Microsoft Outlook 1X.0 Library
  Dim OutObj As Outlook.Application
  Dim OutAppt As Outlook.AppointmentItem
  Dim Lig As Long, Sujet As String, Détail As String
  Dim sDate As String, Heure As String, HTemp As String
  Dim Delai As Integer, Rappel As Single
  ' Récupérer les paramètres pour OUTLOOK
  Delai = VParam("OutlookDélaiRDV")
  Rappel = VParam("OutlookRappel")
  ' Ligne sur la feuille
  Lig = Selection.Row
  Sujet = "Rappel pour la société : " & Range("A" & Lig).Value & " - Installation : " & Range("C" & Lig).Value
  sDate = Format(Range("H" & Lig).Value - (3 * 30.5), "dd/mm/yyyy")
  If sDate = "" Then
    MsgBox "Vous devez une date de fin de contrat !", vbCritical, "ATTENTION ..."
    Range("H" & Lig).Select
    Exit Sub
  End If
  On Error Resume Next
  ' Heure de rappel
  Heure = Format(VParam("OutlookHeureR"), "HH:MM")
  ' Demander l'heure
  HTemp = InputBox("A qu'elle heure voulez-vous faire le rappel (HH:MM) ?", "HEURE de RAPPEL ...", Heure)
  If HTemp <> "" And HTemp <> Heure Then
    If InStr(1, HTemp, ":") > 0 Then Heure = HTemp
  End If
  ' Délai de la période 1 heure avant
  Heure = Format(Heure, "hh:mm:ss")
  On Error GoTo 0
  ' Créer l'instance OUTLOOK
  Set OutObj = CreateObject("outlook.application")
  ' Créer l'instance pour le RDV
  Set OutAppt = OutObj.CreateItem(olAppointmentItem)
  ' Si tout est OK, on créé un RDV
  With OutAppt
    .Start = sDate & " " & Heure
    .Duration = Delai
    .Location = "Montargis"
    .ReminderMinutesBeforeStart = Rappel * 60 ' rappeler 8 heure avant
    .ReminderSet = True
    .Subject = Sujet
    .Body = Détail
    '.MeetingStatus = olMeeting
    '.OptionalAttendees = "titi@adm.co.ma" 'participants optionnel à la réunion
    ' Participant(s) obligatoire(s)
    '.RequiredAttendees = "DestOutlook"
    '.Send
    .Save
  End With
  ' Libérez la variable objet Outlook.
  Set OutObj = Nothing
  Set OutAppt = Nothing
  ' Petit message
  MsgBox "Le Rendez-vous à bien été ajouté ! ", vbInformation, "OK ..."
End Sub

Voir ton fichier joint modifié ;)

A+
 

Pièces jointes

  • Juyce_Site A.xlsm
    41.2 KB · Affichages: 188

juyce

XLDnaute Nouveau
Re : Création rappel Outlook

Bonjour,

Merci beaucoup !

J'ai juste une petite question, j'ai l'impression que çà ne prend le rdv que pour la cellule sélectionnée, j'aimerais que la prise de rdv se fasse sur toute la feuille... Que dois-je modifier pour cela? D'autre part si on fait cette modification il faudra qu'il y ait forcément une date de fin de contrat or pour certains il n'y en a pas... je pense quil faut mettre un SI mais je ne sais pas comment le formuler... Je n'en suis qu'à mes début :)

Merci beaucoup de votre aide !
 

BrunoM45

XLDnaute Barbatruc
Re : Création rappel Outlook

Salut Juyce ;)

Effectivement le code ne faisait que la ligne sélectionnée

Voici le code pour remplacement du précédent
VB:
' Ajouter un nouveau rendez-vous.
Sub RappelOutlook()
' Il est nécessaire de définir la référence : Microsoft Outlook 1X.0 Library
  Dim OutObj As Outlook.Application
  Dim OutAppt As Outlook.AppointmentItem
  Dim Sht As Worksheet
  Dim DLig As Long, Lig As Long, Sujet As String, Détail As String
  Dim sDate As String, Heure As String, HTemp As String
  Dim Delai As Integer, NbMois As Integer, Rappel As Single
  ' Récupérer les paramètres pour OUTLOOK
  Heure = Format(VParam("OutlookHeureR"), "hh:mm:ss") ' Heure de rappel
  Rappel = VParam("OutlookRappel")  ' Prévenir avant l'heure de
  Delai = VParam("OutlookDélaiRDV") ' Délai du RDV en minutes
  NbMois = VParam("MoisAvantEcheance")  ' Prévenir X mois avant échéance
  ' Demander l'heure de rappel au cas ou
  HTemp = InputBox("A qu'elle heure voulez-vous faire le rappel (HH:MM) ?", "HEURE de RAPPEL ...", Heure)
  If HTemp <> "" And HTemp <> Heure Then
    If InStr(1, HTemp, ":") > 0 Then Heure = Format(HTemp, "hh:mm:ss")
  End If
  ' Définir la feuille source
  Set Sht = Sheets("Frais")
  ' Récupérer la dernière ligne du tableau
  DLig = Sht.Range("A" & Rows.Count).End(xlUp).Row
  ' Créer l'instance OUTLOOK
  Set OutObj = CreateObject("outlook.application")
  ' Pour chaque ligne sur la feuille
  For Lig = 2 To DLig
    ' Créer le sujet du mail
    Sujet = "Rappel pour la société : " & Sht.Range("A" & Lig).Value & " - Installation : " & Sht.Range("C" & Lig).Value
    ' Récupérer la date de fin de contrat
    sDate = Sht.Range("H" & Lig).Value
    ' Si aucune date, on passe à la ligne suivante
    If sDate = "" Then GoTo LigneSuivante
    ' Formater la date correctement
    sDate = Format(CDate(sDate) - (NbMois * 30.417), "dd/mm/yyyy")
    ' Créer l'instance pour le RDV
    Set OutAppt = OutObj.CreateItem(olAppointmentItem)
    ' Si tout est OK, on créé un RDV
    With OutAppt
      .Start = sDate & " " & Heure
      .Duration = Delai
      .Location = "Bureau"
      .ReminderMinutesBeforeStart = Rappel * 60  ' rappeler 8 heure avant
      .ReminderSet = True
      .Subject = Sujet
      .Body = Détail
      '.MeetingStatus = olMeeting
      '.OptionalAttendees = "titi@adm.co.ma" 'participants optionnel à la réunion
      ' Participant(s) obligatoire(s)
      '.RequiredAttendees = "DestOutlook"
      '.Send
      .Save
    End With
    ' Effacer la variable objet des RDV pour le prochain
    Set OutAppt = Nothing
    ' On continue
LigneSuivante:
  Next Lig
  ' Libérez la variable objet Outlook.
  Set OutObj = Nothing
  ' Petit message
  MsgBox "Le(s) Rendez-vous à/ont bien été ajouté ! ", vbInformation, "OK ..."
End Sub

A+
 

juyce

XLDnaute Nouveau
Re : Création rappel Outlook

Rebonjour,

J'ai supprimer l'ancien code pour le remplacer par celui-ci et il m'affiche un message d'erreur... j'ai voulu le corriger toute seule mais je n'ai pas compris :) voici l'erreur:

Function VParam(NomRng As String, Optional ValRng As Variant)
With ThisWorkbook.Sheets("Params")
If Not IsMissing(ValRng) Then
.Range(NomRng).Value = ValRng
Else
VParam = .Range(NomRng).Value
End If
End With
End Function

Merci d'avance pour c epetit coup de pouce !
 

BrunoM45

XLDnaute Barbatruc
Re : Création rappel Outlook

Re,

Navré, c'est de ma faute :eek: car j'ai omis de te dire que j'avais créé un nouveau nom dans la feuille Params

Pour la cellule A5 j'ai créé le nom : MoisAvantEcheance avec la valeur 3 dedans
Ce qui te permets de paramétrer simplement le nombre de mois avant échéance pour les rappels

Fichier modifié joint

Ma fonction VParam() te permet de lire ou d'écrire (si 3ème argument donné) les paramètres nommés de la feuille Params

A+
 

Pièces jointes

  • ScreenShot206.jpg
    ScreenShot206.jpg
    22.1 KB · Affichages: 144
  • Juyce_Site A v2.xlsm
    41.1 KB · Affichages: 123

juyce

XLDnaute Nouveau
Re : Création rappel Outlook

Super !

Merci beaucoup ! C'est génial !

Et si dans l'avenir j'ai des colonnes à insérer entre celles qui existent déjà, est ce que je peux facilement modifier la macro pour qu'il prenne bien les bonnes colones (celles qui existent aujourdhui) ?
 

juyce

XLDnaute Nouveau
Re : Création rappel Outlook

Autant pour moi, j'ai trouvé la réponse à ma question comme une grande. En rvanche çà je ne trouve pas, est-il posisble de ne pas prendre notes des rdv antérieurs à la date d'aujourdhui?

Et est ce que si je fais la manip 'prendre les rdv" toutes les semaines il va mettre les rdv en doublons?
 

BrunoM45

XLDnaute Barbatruc
Re : Création rappel Outlook

Re,

Désolé, j'ai modifié le code de la sorte ;)
VB:
' Ajouter un nouveau rendez-vous' Si la date de fin de contrat est renseignée
' Si la date de fin de contrat en colonne H est postérieur à la date du jour
' Si cela n'a pas déjà été fait => noté en colonne I
Sub RappelOutlook()
' Il est nécessaire de définir la référence : Microsoft Outlook 1X.0 Library
  Dim OutObj As Outlook.Application
  Dim OutAppt As Outlook.AppointmentItem
  Dim Sht As Worksheet
  Dim DLig As Long, Lig As Long, Sujet As String, Détail As String
  Dim sDate As String, Heure As String, HTemp As String
  Dim Delai As Integer, NbMois As Integer, Rappel As Single
  ' Récupérer les paramètres pour OUTLOOK
  Heure = Format(VParam("OutlookHeureR"), "hh:mm:ss") ' Heure de rappel
  Rappel = VParam("OutlookRappel")  ' Prévenir avant l'heure de
  Delai = VParam("OutlookDélaiRDV") ' Délai du RDV en minutes
  NbMois = VParam("MoisAvantEcheance")  ' Prévenir X mois avant échéance
  ' Demander l'heure de rappel au cas ou
  HTemp = InputBox("A qu'elle heure voulez-vous faire le rappel (HH:MM) ?", "HEURE de RAPPEL ...", Heure)
  If HTemp <> "" And HTemp <> Heure Then
    If InStr(1, HTemp, ":") > 0 Then Heure = Format(HTemp, "hh:mm:ss")
  End If
  ' Définir la feuille source
  Set Sht = Sheets("Frais")
  ' Récupérer la dernière ligne du tableau
  DLig = Sht.Range("A" & Rows.Count).End(xlUp).Row
  ' Créer l'instance OUTLOOK
  Set OutObj = CreateObject("outlook.application")
  ' Pour chaque ligne sur la feuille
  For Lig = 2 To DLig
    ' Vérifier que le rappel n'a pas déjà été fait, sinon ligne suivante
    If Sht.Range("I" & Lig).Value <> "" Then GoTo LigneSuivante
    ' Récupérer la date de fin de contrat
    sDate = Sht.Range("H" & Lig).Value
    ' Vérifier si aucune date, on passe à la ligne suivante
    If sDate = "" Then GoTo LigneSuivante
     ' Vérifier que la date de fin de contrat est postérieur à la date du jour
     ' Sinon ligne suivante
    If CDate(sDate) < Date Then GoTo LigneSuivante
    '
    ' Tout est OK, on inscrit en colonne I le terme : Fait
    Sht.Range("I" & Lig).Value = "Fait"
    '
    ' Formater la date correctement
    sDate = Format(CDate(sDate) - (NbMois * 30.417), "dd/mm/yyyy")
    ' Créer le sujet du mail
    Sujet = "Rappel pour la société : " & Sht.Range("A" & Lig).Value & " - Installation : " & Sht.Range("C" & Lig).Value
    ' Créer l'instance pour le RDV
    Set OutAppt = OutObj.CreateItem(olAppointmentItem)
    ' Si tout est OK, on créé un RDV
    With OutAppt
      .Start = sDate & " " & Heure
      .Duration = Delai
      .Location = "Bureau"
      .ReminderMinutesBeforeStart = Rappel * 60  ' rappeler 8 heure avant
      .ReminderSet = True
      .Subject = Sujet
      .Body = Détail
      '.MeetingStatus = olMeeting
      '.OptionalAttendees = "titi@adm.co.ma" 'participants optionnel à la réunion
      ' Participant(s) obligatoire(s)
      '.RequiredAttendees = "DestOutlook"
      '.Send
      .Save
    End With
    ' Effacer la variable objet des RDV pour le prochain
    Set OutAppt = Nothing
    ' On continue
LigneSuivante:
  Next Lig
  ' Libérez la variable objet Outlook.
  Set OutObj = Nothing
  ' Petit message
  MsgBox "Le(s) Rendez-vous à/ont bien été ajouté ! ", vbInformation, "OK ..."
End Sub

Voir fichier joint

Pour voir tous tes RDV, Menu -> Affichage -> Affichage actuel -> Tous les RDV

A+
 

Pièces jointes

  • Juyce_Site A v3.xlsm
    42.6 KB · Affichages: 179

BrunoM45

XLDnaute Barbatruc
Re : Création rappel Outlook

Re,

1) le test sur la date de fin de contrat, si celle-ci est inférieure à la date du jour, on passe la ligne
2) l'inscription dans la colonne "I" de l'info "Fait" lors de la création du RDV
Cette ligne est passée si le terme existe déjà

Est-ce plus clair ?

A+
 

Statistiques des forums

Discussions
286 422
Messages
1 876 105
Membres
160 161
dernier inscrit
bibicaramia
Haut Bas