Boucle pour trouver le bon calendrier

Bonjour

Je souhaite creer des rdv dans des calendrier partager outlook depuis un tableau qui contien les information des rdv et pour chaque rdv le calendrier conserner dans la colonne A

J'ai trouver ce code que je ne sais pas adapter .

Merci pour votre aide .

Sub RDV()
     Dim OutObj As New Outlook.Application
     Dim OutAppt As Outlook.AppointmentItem
     Dim MyCalendar As Outlook.Items

     Set OutObj = CreateObject("Outlook.Application")
        nb = OutObj.GetNamespace("MAPI").Folders.Item(10).Folders.Count
        For x = 1 To nb 'boucle pour trouver le bon calendrier
        If OutObj.GetNamespace("MAPI").Folders.Item(10).Folders.Item(x) = Range("A1") Then 'Range("A1")est le nom du calendrier dans lequel il faut envoyer le RDV
             Set MyCalendar = OutObj.GetNamespace("MAPI").Folders.Item(10).Folders.Item(x).Items

              MsgBox "Envoi sur le calendrier " & OutObj.GetNamespace("MAPI").Folders.Item(10).Folders.Item(x) 'confiramation de calendrier
              Set OutAppt = MyCalendar.Add(olAppointmentItem) 'creation de RDV
      Set OutAppt = MyCalendar.Add(olAppointmentItem)
     With OutAppt
          .Start = Now 'Date et Heure du début du RDV
          .Duration = 120 'Durée du RDV en minute
          .Subject = "Test de RDV" 'titre du RDV
          .Body = "Pour un essai"
          .Location = "26000 VALENCE"
          .ReminderSet = True
          .Save
     End With
       End If
       Next x

     Set OutObj = Nothing
     Set OutAppt = Nothing
     Set MyCalendar = Nothing
End Sub

Bonjour,

Alors je vois......

Ah ben non... rien...

Bonjour

Voici le fichier