Aide rdv outlook via Excel

Bonjour,

Je me trouve dans une impasse, j'utilise un code afin de récupérer dans une sélection, des dates afin de créer des rappels au sein de membre de mon équipe.

Cependant j'ai dans mon tableau des dizaines de fois la même date, donc cela surcharge les calendriers. Il y a t-il possibilité de créer un seul rdv par date ?

ce code :

Sub rdvvgp()

Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem
Dim dates, date_i As Range

Set dates = Selection
    For Each date_i In dates.Rows
        If IsDate(date_i.Value) Then
        Set Rdv = OkApp.CreateItem(olAppointmentItem)

            With Rdv
                .MeetingStatus = olMeeting
                .Subject = "Rappel VGP"
                .Location = "A8"
                .Start = date_i.Value
                .AllDayEvent = True
                .Duration = 60
                .ReminderMinutesBeforeStart = 10080
                .ReminderSet = True
                .BusyStatus = olOutOfOffice
                .Save
            End With

        End If
    Next

Set OkApp = Nothing

End Sub

Bonne journée,

Arthur