XL 2013 VBA envoyer une rendez-vous vers Outlook

E

Eric BZH

XLDnaute Nouveau
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]
 
Dernière modification par un modérateur:
Trier par date Trier par votes
C

Compte Supprimé 979

Guest
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+
 
Vote positif 0 Vote négatif
E

Eric BZH

XLDnaute Nouveau
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.
Cliquez pour agrandir...

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+
Cliquez pour agrandir...
Merci pour votre aide.
C'est parfait ! Vous m'avez ouvert à d'autres idées et fonctions.

Merci encore.
 
Vote positif 0 Vote négatif

Discussions similaires

W
  • Question
XL 2016 Joindre par mail un fichier.pdf personnalité selon le prénom trouvé dans le titre du pdf
Réponses
8
Affichages
560
TooFatBoy
TooFatBoy
D
  • Question
XL 2019 envoyer un email quand une date arrive à échéance
2
Réponses
19
Affichages
655
job75
job75
N
  • Question
XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe
Réponses
4
Affichages
234
Phil69970
Phil69970
G
  • Question
Microsoft 365 Vba Excel l'instruction Set OutApp = CreateObject("Outlook.Application") bloque excel
Réponses
2
Affichages
146
laurent950
laurent950
P
  • Question
Microsoft 365 Joindre un fichier PDF dans un mail + inclure date envoi du mail dans un autre onglet
Réponses
1
Affichages
437
kiki29
kiki29
C
  • Résolu(e)
XL 2021 Période d'un calendrier outlook vers Excel
Réponses
3
Affichages
454
combory
C
B
  • Question
XL 2019 Exportation Feuille PDF VBA
Réponses
2
Affichages
512
kiki29
kiki29
L
  • Résolu(e)
XL 2021 Aide VBA pour appli Gestion de stock
Réponses
2
Affichages
237
LuckyShuri
L
M
  • Résolu(e)
Microsoft 365 [Résolu] Bouton nommé par exemple C qui va chercher les mots commençants par C dans une colonne
Réponses
13
Affichages
225
Marboi
M
S
  • Question
Microsoft 365 [Outlook] Macro pour récupérer les données dans propriétés outlook
Réponses
2
Affichages
649
Sarah_Croche
S

Membres actuellement en ligne

6 membres et 58 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 104
dernier inscrit
JEMADA