Demande de rendez-vous Outlook

[So22]

Bonjour,

Je souhaite faire une demande de rendez-vous à une personne. Son calendrier n'est pas partagé, je ne peux donc pas créer un rendez-vous directement.
Je suis repartie d'un code existant posté sur ce site par Michel mais le rendez-vous est crée dans mon calendrier (et n'est du coup pas une demande de rendez-vous)

Sub NouveauRDV_Calendrier()
'nécéssite d'activer la référence Microsoft Outlook 10.0 Object Library
Dim myOlApp As New Outlook.Application
Dim MyItem As Outlook.AppointmentItem
Dim myNamespace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Dim Cell As Range

Set myNamespace = myOlApp.GetNamespace("MAPI")

Dim CalendarFolder As Outlook.MAPIFolder
Set myRecipient = myNamespace.CreateRecipient("s.a@a.fr")
myRecipient.Resolve
If myRecipient.Resolved Then
    Set CalendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
Else
    Exit Sub
End If
    

For Each Cell In Range("A8:A" & Range("A22").End(xlUp).Row)
    Set MyItem = myOlApp.CreateItem(olAppointmentItem)
    
    With MyItem
        .MeetingStatus = olNonMeeting
        .Subject = Cell
        .Start = Cell.Offset(0, 1) ' Attention : format mm/dd/yy
        .Duration = Cell.Offset(0, 2) 'minutes
        .Location = Cell.Offset(0, 3)
        .Save
    End With
    
    Set MyItem = Nothing
Next Cell

End Sub

Merci de votre aide