outlook calendrier et excel

[julienb25]

Bonjour,
j'ai un fichier de prospection client sur Excel. J'ai récemment fait une userform qui quand elle s'ouvre regroupe les différentes informations a propos des mes futur clients. Dans cette userform j'ai également intégré une macro me permettant de mettre un rappel dans le calendrier outlook lorsque les clients me demande de les rappeler plus tard. Jusque la tout fonctionne le seul problème c'est que je n'arrive pas à mettre plusieurs rappel à la même heure...

avez vous des solutions
je vous joint le bout de code qui me permet d'envoyer les rappel dans outlook calendrier (que j'ai modifier suite à un post sur le forum):

Sub calendrier_aujourdhui()
Dim DateDebut As String
Dim OutlApp As New Outlook.Application
Dim OutlItems As Outlook.Items
Dim OutlAppointment As Outlook.AppointmentItem
Dim myOlApp As New Outlook.Application
Dim MyCalendar As Outlook.Items
Dim OutlMapi As Outlook.Namespace
Dim OutlFolder As Outlook.MAPIFolder
Dim MyItem As Outlook.AppointmentItem
Dim myNamespace As Outlook.Namespace
Dim Cell As Range
Dim cal As String



'plage de donnée
cellulevide = Sheets("a rappeler").Range("J1") ' correspond a la cellule 1 de la 10 eme colone (stock la valeur de la derniere ligne utilisé)
Sheets("a rappeler").Cells(cellulevide, 1).Activate



'On choisi le calendrier
Set myOlApp = CreateObject("Outlook.Application")
'Concernant la ligne suivante après le ("MAPI")
' Folders.Item(1) : correspond au dossier Personnel
' Folders.Item(5) : correspond au dossier Calendrier standard
' Folders.Item(1) : correspond au sous calendrier, s'il y en a d'autre remplacer par le n° d'index...
Set MyCalendar = myOlApp.GetNamespace("MAPI").Folders.Item(1).Folders.Item(5).Items 'choix calendrier perso
'Fin choix calendrier

If ActiveCell <> "" Then
DATEFICH = ActiveCell.Offset(0, 1)
'DATEFICH = Format(DATEFICH, "mm/dd/yy")
Set MyItem = MyCalendar.Add(olAppointmentItem) 'Set MyItem = myOlApp.CreateItem(olAppointmentItem)
With MyItem 'inscription des données dans excel
.MeetingStatus = olNonMeeting 'meeting
.ReminderSet = True ' S'il y a un rappel
.Subject = "RAPELLER " & ActiveCell.Offset(0, 0) 'Sujet
.Start = DATEFICH & " " & ActiveCell.Offset(0, 2) ' Date plus heure. Attention : format mm/dd/yy
.AllDayEvent = False ' Toute la journée oui/non
.Duration = 5 'minutes"
.Location = "" 'emplacement et body pour les commentaires ou sujets
.Body = "NOM : " & ActiveCell _
& "Date de creation du rappel : " & ActiveCell.Offset(0, 5) _
& "Observations :" & ActiveCell.Offset(0, 4)

.Save
End With
Set MyItem = Nothing
End If


Sheets("a rappeler").Range("J1") = Sheets("a rappeler").Range("J1") + 1
Passe: '< ****** RAJOUTE CECI


End Sub