XL 2013 VBA envoyer une rendez-vous vers Outlook

Eric BZH · 12 Octobre 2022

Bonjour à toutes et tous,

J'ai un fichier excel dans lequel j'ai un bouton VBA pour générer le PDF de ma page "devis", PDF que je transmets par email à mon client dans la foulée.
J'ai besoin de votre aide pour la chose suivante :
Je souhaite créer, pour ce PDF (variables Excel dans chaque case) un avis de rendez-vous dans le calendrier Outlook de mes livreurs.
J'ai le nom et prénom ainsi que l'email du livreur, le lieu du rendez-vous, la date, l'heure et la durée prévue, mission, le nom et prénom du contact sur place ainsi que son email, son téléphone.
Dans le fichier en exemple, je ne vous présente pas mes "boutons" VBA
Je voudrai juste avoir le coup de main sur ce point que j'essaye de trouver depuis des mois (...) ; en cliquant sur un simple bouton et qui me fera gagner du temps !
Merci à vous pour votre aide.
Cordialement.
Eric.

|modération: fichier contenant des données personnelles, supprimé. Merci d'anonymiser vos données]

Compte Supprimé 979 · 12 Octobre 2022

Bonjour Eric BZH

Attention au fichier que vous mettez en ligne

Ceci dit je l'avais récupéré avant la modération, voici le code à mettre dans un module

VB:

Option Explicit

Const olAppointmentItem As Integer = 1
Const olMeeting As Integer = 1

' Ajouter un nouveau rendez-vous.
Sub RappelOutlook()
  Dim OutObj As Object, OutAppt As Object
  Dim Lig As Long, Sujet As String, Détail As String
  Dim Vdate As String, Heure As String, HTemp As String
  Dim Delai As Double, Rappel As Single, sTmp As String
  ' Ligne sélectionnée sur la feuille
  Lig = Selection.Row
  ' En cas d'erreur
  On Error Resume Next
  ' Vérifier si un commentaire est déjà dans la cellule
  If Range("D" & Lig).Comment.Text <> "" Then
    If Err.Number = 0 Then
      MsgBox "Un RDV à déjà été inscrit, merci de le supprimer dans Outlook", vbInformation, "ATTENTION ...."
      Exit Sub
    End If
  End If
  ' Réactiver les erreurs
  On Error GoTo 0
  ' Récupérer les paramètres pour OUTLOOK
  Delai = Range("F" & Lig).Value * 60 * 24
  Rappel = 24 ' 24h avant
  Sujet = "Rappel pour : " & Range("H" & Lig).Value & "-" & Range("C" & Lig).Value
  Vdate = Range("D" & Lig).Value
  If Vdate = "" Then
    MsgBox "Vous devez inscrire un date !", vbCritical, "ATTENTION ..."
    Range("D" & Lig).Select
    Exit Sub
  End If
  On Error Resume Next
  ' Heure de rappel
  Heure = Range("E" & Lig).Text
  ' En cas d'erreur
  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 = Vdate & " " & Heure
    .Duration = Delai
    .Location = Range("C" & Lig).Value
    .ReminderMinutesBeforeStart = Rappel * 60    ' rappeler 8 heure avant
    .ReminderSet = True
    .Subject = Sujet
    .Body = Range("G" & Lig).Value
    '.MeetingStatus = olMeeting
    '.OptionalAttendees = "titi@adm.co.ma" 'participants optionnel à la réunion
    ' Participant(s) obligatoire(s)
    '.RequiredAttendees = "DestOutlook"
    '.Send
    .Save
  End With
  ' En cas d'erreur on continue
  On Error Resume Next
  ' Inscrire le commentaire dans la cellule
  With Range("D" & Lig)
    .ClearComments
    .AddComment Text:=Sujet
    .Comment.Visible = False
  End With
  ' Gestion des erreurs
  On Error GoTo 0
  ' 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

A+

Eric BZH · 1 Novembre 2022

BrunoM45 à dit:

Bonjour Eric BZH

Attention au fichier que vous mettez en ligne

Ceci dit je l'avais récupéré avant la modération, voici le code à mettre dans un module

VB:

Option Explicit

Const olAppointmentItem As Integer = 1
Const olMeeting As Integer = 1

' Ajouter un nouveau rendez-vous.
Sub RappelOutlook()
  Dim OutObj As Object, OutAppt As Object
  Dim Lig As Long, Sujet As String, Détail As String
  Dim Vdate As String, Heure As String, HTemp As String
  Dim Delai As Double, Rappel As Single, sTmp As String
  ' Ligne sélectionnée sur la feuille
  Lig = Selection.Row
  ' En cas d'erreur
  On Error Resume Next
  ' Vérifier si un commentaire est déjà dans la cellule
  If Range("D" & Lig).Comment.Text <> "" Then
    If Err.Number = 0 Then
      MsgBox "Un RDV à déjà été inscrit, merci de le supprimer dans Outlook", vbInformation, "ATTENTION ...."
      Exit Sub
    End If
  End If
  ' Réactiver les erreurs
  On Error GoTo 0
  ' Récupérer les paramètres pour OUTLOOK
  Delai = Range("F" & Lig).Value * 60 * 24
  Rappel = 24 ' 24h avant
  Sujet = "Rappel pour : " & Range("H" & Lig).Value & "-" & Range("C" & Lig).Value
  Vdate = Range("D" & Lig).Value
  If Vdate = "" Then
    MsgBox "Vous devez inscrire un date !", vbCritical, "ATTENTION ..."
    Range("D" & Lig).Select
    Exit Sub
  End If
  On Error Resume Next
  ' Heure de rappel
  Heure = Range("E" & Lig).Text
  ' En cas d'erreur
  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 = Vdate & " " & Heure
    .Duration = Delai
    .Location = Range("C" & Lig).Value
    .ReminderMinutesBeforeStart = Rappel * 60    ' rappeler 8 heure avant
    .ReminderSet = True
    .Subject = Sujet
    .Body = Range("G" & Lig).Value
    '.MeetingStatus = olMeeting
    '.OptionalAttendees = "titi@adm.co.ma" 'participants optionnel à la réunion
    ' Participant(s) obligatoire(s)
    '.RequiredAttendees = "DestOutlook"
    '.Send
    .Save
  End With
  ' En cas d'erreur on continue
  On Error Resume Next
  ' Inscrire le commentaire dans la cellule
  With Range("D" & Lig)
    .ClearComments
    .AddComment Text:=Sujet
    .Comment.Visible = False
  End With
  ' Gestion des erreurs
  On Error GoTo 0
  ' 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

Merci beaucoup. Je vais tester ça très vite.

BrunoM45 à dit:

Bonjour Eric BZH

Attention au fichier que vous mettez en ligne

Ceci dit je l'avais récupéré avant la modération, voici le code à mettre dans un module

VB:

Option Explicit

Const olAppointmentItem As Integer = 1
Const olMeeting As Integer = 1

' Ajouter un nouveau rendez-vous.
Sub RappelOutlook()
  Dim OutObj As Object, OutAppt As Object
  Dim Lig As Long, Sujet As String, Détail As String
  Dim Vdate As String, Heure As String, HTemp As String
  Dim Delai As Double, Rappel As Single, sTmp As String
  ' Ligne sélectionnée sur la feuille
  Lig = Selection.Row
  ' En cas d'erreur
  On Error Resume Next
  ' Vérifier si un commentaire est déjà dans la cellule
  If Range("D" & Lig).Comment.Text <> "" Then
    If Err.Number = 0 Then
      MsgBox "Un RDV à déjà été inscrit, merci de le supprimer dans Outlook", vbInformation, "ATTENTION ...."
      Exit Sub
    End If
  End If
  ' Réactiver les erreurs
  On Error GoTo 0
  ' Récupérer les paramètres pour OUTLOOK
  Delai = Range("F" & Lig).Value * 60 * 24
  Rappel = 24 ' 24h avant
  Sujet = "Rappel pour : " & Range("H" & Lig).Value & "-" & Range("C" & Lig).Value
  Vdate = Range("D" & Lig).Value
  If Vdate = "" Then
    MsgBox "Vous devez inscrire un date !", vbCritical, "ATTENTION ..."
    Range("D" & Lig).Select
    Exit Sub
  End If
  On Error Resume Next
  ' Heure de rappel
  Heure = Range("E" & Lig).Text
  ' En cas d'erreur
  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 = Vdate & " " & Heure
    .Duration = Delai
    .Location = Range("C" & Lig).Value
    .ReminderMinutesBeforeStart = Rappel * 60    ' rappeler 8 heure avant
    .ReminderSet = True
    .Subject = Sujet
    .Body = Range("G" & Lig).Value
    '.MeetingStatus = olMeeting
    '.OptionalAttendees = "titi@adm.co.ma" 'participants optionnel à la réunion
    ' Participant(s) obligatoire(s)
    '.RequiredAttendees = "DestOutlook"
    '.Send
    .Save
  End With
  ' En cas d'erreur on continue
  On Error Resume Next
  ' Inscrire le commentaire dans la cellule
  With Range("D" & Lig)
    .ClearComments
    .AddComment Text:=Sujet
    .Comment.Visible = False
  End With
  ' Gestion des erreurs
  On Error GoTo 0
  ' 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

A+

Merci pour votre aide.
C'est parfait ! Vous m'avez ouvert à d'autres idées et fonctions.

Merci encore.

Effectuez une recherche sur Excel Downloads...

XL 2013 VBA envoyer une rendez-vous vers Outlook

Eric BZH

XLDnaute Nouveau

Compte Supprimé 979

Guest

Eric BZH

XLDnaute Nouveau

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums