Microsoft 365 Créer rendez-vous outlook via macro

matthieu2701

XLDnaute Occasionnel
Bonjour,

J'ai un tableau me permettant de collecter et de faire un suivi de formation.

En colonne L, j'ai la date programmée de la formation et en colonne M le créneau horaire.

Je souhaiterais créer un rendez-vous dans outlook avec les éléments remplis dans ces colonnes et envoyer l'invitation à l'agent concerné qui est noté en colonne A.

Aussi, si la date programmée vient à être modifiée, est-il possible d'annuler le rendez-vous précédent et d'en créer un nouveau avec la nouvelle date ?

Enfin, je souhaite aussi qu'un rendez-vous soit créé, pour qu'un contrôle soit effectué après la formation (Date en colonne P).

Merci par avance de votre retour.
 

Pièces jointes

  • Compétencier.xlsx
    18.4 KB · Affichages: 16

kingfadhel

XLDnaute Impliqué
Bon après midi à tous,

J'ai trouvé un bout de code j’espère que ça fait l'affaire

VB:
Sub AjoutRDVCalendrier()
 
    'déclaration des variables
    Dim oOutlook As Outlook.Application
    Dim oAppointment As Outlook.AppointmentItem
    Dim namespaceOutlook As Outlook.Namespace
    Dim DossierCalendrier As Outlook.MAPIFolder
    Dim myTasks As Outlook.folder
    Dim myFolder As Outlook.folder
    'gestion d'erreurs
    On Error GoTo Err_Execution
    'on crée ensuite les objets
    Set oOutlook = CreateObject("Outlook.Application")
    Set namespaceOutlook = oOutlook.GetNamespace("MAPI")
    Set myTasks = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
    Set myFolder = myTasks.Folders(1)
    Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
    'on crée un nouveau rendez-vous
   Set oAppointment = DossierCalendrier.items.Add
     'on renseigne ensuite les principaux paramètres
    With oAppointment
        .Start = "30/01/2020 12:00:00"
        .Duration = 180 'durée de rdv, en minutes
        .Subject = "Réunion avec Mark" 'Sujet du rdv
        .Body = "" 'corps du texte de la réunion
        .Location = "Timhotel Paris" 'Lieu du rdv
        'on sauvegarde et ferme
        .Save
        .Close (olSave)
    End With
    Set DossierCalendrier = myFolder
    'on crée un nouveau rendez-vous
    Set oAppointment = DossierCalendrier.items.Add
    'on renseigne ensuite les principaux paramètres
    With oAppointment
        .Start = "30/01/2020 12:00:00"
        .Duration = 180 'durée de rdv, en minutes
        .Subject = "Réunion avec Mark " 'Sujet du rdv
        .Body = "" 'corps du texte de la réunion
        .Location = "Timhotel Paris" 'Lieu du rdv
        'on sauvegarde et ferme
        .Save
        .Close (olSave)
    End With
    'Libération des variables.
    Set oAppointment = Nothing
    Set oOutlook = Nothing
Fin_Execution:
    Exit Sub
Err_Execution:
 
    MsgBox Err.Description, vbExclamation
    Resume Fin_Execution
End Sub


à tester
 

matthieu2701

XLDnaute Occasionnel
Bon après midi à tous,

J'ai trouvé un bout de code j’espère que ça fait l'affaire

VB:
Sub AjoutRDVCalendrier()

    'déclaration des variables
    Dim oOutlook As Outlook.Application
    Dim oAppointment As Outlook.AppointmentItem
    Dim namespaceOutlook As Outlook.Namespace
    Dim DossierCalendrier As Outlook.MAPIFolder
    Dim myTasks As Outlook.folder
    Dim myFolder As Outlook.folder
    'gestion d'erreurs
    On Error GoTo Err_Execution
    'on crée ensuite les objets
    Set oOutlook = CreateObject("Outlook.Application")
    Set namespaceOutlook = oOutlook.GetNamespace("MAPI")
    Set myTasks = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
    Set myFolder = myTasks.Folders(1)
    Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
    'on crée un nouveau rendez-vous
   Set oAppointment = DossierCalendrier.items.Add
     'on renseigne ensuite les principaux paramètres
    With oAppointment
        .Start = "30/01/2020 12:00:00"
        .Duration = 180 'durée de rdv, en minutes
        .Subject = "Réunion avec Mark" 'Sujet du rdv
        .Body = "" 'corps du texte de la réunion
        .Location = "Timhotel Paris" 'Lieu du rdv
        'on sauvegarde et ferme
        .Save
        .Close (olSave)
    End With
    Set DossierCalendrier = myFolder
    'on crée un nouveau rendez-vous
    Set oAppointment = DossierCalendrier.items.Add
    'on renseigne ensuite les principaux paramètres
    With oAppointment
        .Start = "30/01/2020 12:00:00"
        .Duration = 180 'durée de rdv, en minutes
        .Subject = "Réunion avec Mark " 'Sujet du rdv
        .Body = "" 'corps du texte de la réunion
        .Location = "Timhotel Paris" 'Lieu du rdv
        'on sauvegarde et ferme
        .Save
        .Close (olSave)
    End With
    'Libération des variables.
    Set oAppointment = Nothing
    Set oOutlook = Nothing
Fin_Execution:
    Exit Sub
Err_Execution:

    MsgBox Err.Description, vbExclamation
    Resume Fin_Execution
End Sub


à tester

Bonjour,

Merci de ton aide.

J'ai essayé mais je n'arrive pas à la faire fonctionner.

J'ai encore besoin de votre aide svp

Merci
 

Statistiques des forums

Discussions
314 485
Messages
2 110 101
Membres
110 663
dernier inscrit
ToussaintBug