Créer une alerte dans le calendrier Outlook suivant le fichier Excel

Bonjour,

Petit nouveau sur le site, je ne suis pas doué avec le vba et d'après mes recherches c'est par macro que la résolution peut se faire.

Donc je souhaite de l'aide pour créer des alertes (un rappel) dans mon calendrier Outlook et celui de mon collègue quand une date arrive 40 jours avant les échéances.

Le rappel : le nom en (A) puis en fonction de la date en (b) à J 40 avant indique "sélection méd le xx/xx/xx et la même chose pour le nom et (C) "cap" le xx/xx/xx.

C'est très loin de mes compétences et j'ai faits des tentatives avec un fichier présent sur le forum mais je ne comprends pas.

J'aimerais aussi que si on modifie une date dans le fichier Excel, le rappel s'adapte a cette nouvelle date.

D'avance merci pour votre aide et pour votre temps.

Numéro13

Bonjour Numero23,

Voici une approche, mais je ne l'ai pas testé à mon niveau pour ne pas "polluer" mon Outlook. J'ai modifié le nom de la feuille.

Ce code ajoute une condition pour vérifier :

a) si la date de début (la date de la colonne B moins 40 jours) est exactement à 40 jours à partir d’aujourd’hui. Si c’est le cas, il crée un nouvel élément de calendrier dans Outlook avec une alerte. Le sujet de l’alerte comprend "Sélection MED, puis le nom de la colonne A et la date de la colonne B.

b) et pour les dates de la colonne C qui sont à 40 jours, avec le sujet de l’alerte comprend "CAP", puis le nom de la colonne A et la date de la colonne C.

Les alertes sont à 09:00 pour une durée de 60 minutes avec rappel 15 minutes avant l'heure. A vous de modifier si besoin

A tester

Sub CreerAlertesOutlook()
    Dim olApp As Object
    Dim olApt As Object
    Dim ws As Worksheet
    Dim i As Long
    Dim DerLigne As Long
    Dim startDate As Date
    Dim nom As String
    Dim dateStr As String

    ' Définir la feuille de calcul
    Set ws = ThisWorkbook.Sheets("RDV")

    ' Créer une nouvelle instance d'Outlook
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then Set olApp = CreateObject("Outlook.Application")
    On Error GoTo 0

    ' Définir la dernière ligne non vide de la colonne A
    DerLigne = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Parcourir chaque ligne dans la plage à partir de la ligne 6
    For i = 6 To DerLigne
        ' Obtenir le nom de la colonne A
        nom = ws.Cells(i, "A").Value

        ' Obtenir la date de début à partir de la colonne B et soustraire 40 jours
        startDate = ws.Cells(i, "B").Value - 40
        ' Vérifier si la date de début est exactement à 40 jours à partir d'aujourd'hui
        If startDate = Date + 40 Then
            ' Créer un nouvel élément de calendrier
            Set olApt = olApp.CreateItem(1) ' 1 = olAppointmentItem
            With olApt
                .Start = startDate + TimeValue("09:00:00") ' Définir l'heure de début
                .Duration = 60 ' Durée en minutes
                .Subject = "Sélection MED pour " & nom ' Sujet de l'alerte
                .ReminderMinutesBeforeStart = 15 ' Rappel 15 minutes avant le début
                .Save ' Enregistrer l'élément de calendrier
            End With
        End If

        ' Obtenir la date de la colonne C et soustraire 40 jours
        startDate = ws.Cells(i, "C").Value - 40
        ' Vérifier si la date de début est exactement à 40 jours à partir d'aujourd'hui
        If startDate = Date + 40 Then
            ' Créer un nouvel élément de calendrier
            Set olApt = olApp.CreateItem(1) ' 1 = olAppointmentItem
            With olApt
                .Start = startDate + TimeValue("09:00:00") ' Définir l'heure de début
                .Duration = 60 ' Durée en minutes
                .Subject = "CAP pour " & nom ' Sujet de l'alerte
                .ReminderMinutesBeforeStart = 15 ' Rappel 15 minutes avant le début
                .Save ' Enregistrer l'élément de calendrier
            End With
        End If
    Next i

    ' Nettoyer
    Set olApt = Nothing
    Set olApp = Nothing
End Sub

Bonjour,

Donc j'ai renommé ma feuille "RDV" et introduit le code et enregistré.

J'ai modifié des dates dans le fichier Excel et heures dans le vba pour avoir le rappel afin de faire des tests mais aucun rappel.

Faut-il mettre mon adresse mail ? Le fichier Excel doit-il être ouvert ou il peut être fermé?

Merci pour l'aide

Voici le code corrigé et testé à mon niveau

Sub CreerAlertesOutlook4()
    Dim olApp As Object
    Dim olApt As Object
    Dim ws As Worksheet
    Dim i As Long
    Dim DerLigne As Long
    Dim startDate As Date
    Dim nom As String

    ' Définir la feuille de calcul
    Set ws = ThisWorkbook.Sheets("RDV")

    ' Créer une nouvelle instance d'Outlook
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then Set olApp = CreateObject("Outlook.Application")
    On Error GoTo 0

    ' Définir la dernière ligne non vide de la colonne A
    DerLigne = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Parcourir chaque ligne dans la plage à partir de la ligne 6
    For i = 6 To DerLigne
        ' Obtenir le nom de la colonne A
        nom = ws.Cells(i, "A").Value

        ' Obtenir la date de début à partir de la colonne B et soustraire 40 jours
        startDate = ws.Cells(i, "B").Value - 40
        ' Vérifier si la date de début est exactement aujourd'hui
        If DateValue(startDate) = DateValue(Date) Then
            ' Créer un nouvel élément de calendrier
            Set olApt = olApp.CreateItem(1) ' 1 = olAppointmentItem
            With olApt
                .Start = startDate + TimeValue("09:00:00") ' Définir l'heure de début
                .Duration = 60 ' Durée en minutes
                .Subject = "Sélection MED pour " & nom ' Sujet de l'alerte
                .ReminderMinutesBeforeStart = 15 ' Rappel 15 minutes avant le début
                .Save ' Enregistrer l'élément de calendrier
            End With
        End If

        ' Obtenir la date de la colonne C et soustraire 40 jours
        startDate = ws.Cells(i, "C").Value - 40
        ' Vérifier si la date de début est exactement aujourd'hui
        If DateValue(startDate) = DateValue(Date) Then
            ' Créer un nouvel élément de calendrier
            Set olApt = olApp.CreateItem(1) ' 1 = olAppointmentItem
            With olApt
                .Start = startDate + TimeValue("09:00:00") ' Définir l'heure de début
                .Duration = 60 ' Durée en minutes
                .Subject = "CAP pour " & nom ' Sujet de l'alerte
                .ReminderMinutesBeforeStart = 15 ' Rappel 15 minutes avant le début
                .Save ' Enregistrer l'élément de calendrier
            End With
        End If
    Next i

    ' Nettoyer
    Set olApt = Nothing
    Set olApp = Nothing
End Sub

Bonjour,

Super merci c'est cela qu'il me faut. J'abuse mais y a t'il moyen d'avoir avec le nom apparaitre la date :

Subject = "Sélection MED pour " & nom ' + date en colonne B Sujet de l'alerte.

En tout cas chapeau pour ton travail.

N13

Bonjour N13

Modifier ces lignes pour lire

.Subject = "Sélection MED pour " & nom & " " & ws.Cells(i, "B") 
.Subject = "CAP pour " & nom ' Sujet de l'alerte & " " & ws.Cells(i, "C")