Remplir un calendrier sharepoint d'un code VBA et un tableau Excel

Bonjour à tous,

Je cherche à faire une macro VBA qui me permette de remplir un calendrier Sharepoint à partir d'un tableau Excel. Jusqu'à maintenant j'arrive à remplir mon propre calendrier. Mais pour passer vers un calendrier sharepoint je ne vois pas trop ce que je dois corriger dans mon code VBA. Pourriez-vous m'apporter un peu d'aide pour guider mes recherches svp?

Voici mon code initial

Sub AddAppointments()

Dim myOutlook As Outlook.Application
Dim myRecipient As Outlook.Recipient
Dim myNamespace As Outlook.Namespace
Dim myapt As Outlook.AppointmentItem
Dim r As Long

    ' Create the Outlook session
    Set myOutlook = CreateObject("Outlook.Application")

    ' Start at row 2
    r = 2

    Do Until Trim(Cells(r, 1).Value) = ""
        ' Create the AppointmentItem
        Set myapt = myOutlook.CreateItem(olAppointmentItem)
        ' Set the appointment properties
        myapt.Subject = Cells(r, 1).Value
        myapt.Location = Cells(r, 2).Value
        myapt.Start = Cells(r, 3).Value
        myapt.Duration = Cells(r, 4).Value
        ' If Busy Status is not specified, default to 2 (Busy)
        If Trim(Cells(r, 5).Value) = "" Then
            myapt.BusyStatus = 2
        Else
            myapt.BusyStatus = Cells(r, 5).Value
        End If
        If Cells(r, 6).Value > 0 Then
            myapt.ReminderSet = True
            myapt.ReminderMinutesBeforeStart = Cells(r, 6).Value
        Else
            myapt.ReminderSet = False
        End If
        myapt.body = Cells(r, 7).Value
        myapt.Save
        r = r + 1
    Loop
    MsgBox ("Tâches ajoutées au calendrier")
End Sub

Merci d'avance

Finalement, comme bien souvent, il suffit de poser la question pour trouver la réponse.

La difficulté consistait à trouver l'ID du dossier du calendrier. Pour ça, il faut ouvrir le calendrier dans outlook, taper Alt+F11 pour ouvrir la fenêtre d'execution. Dans cette fenêtre il faut écrire : Print ActiveExplorer.CurrentFolder.EntryID

Et là ça renvois l'ID sous la forme d'une suite de caractères assez long.

Bref, je vous dépose ici mon code largement amélioré depuis hier et qui fonctionne.

Sub AddAppointments()

    Dim myOutlook As Object
    Dim myNameSpace As Namespace
    Dim myFolder As Object
    Dim myWorksheet As Worksheet
    Set myWorksheet = Sheets("Calendrier") ' Replace the name of your worksheet

    ' Configuration of your parameters, change values according to your needs
    SubjectCell = 1
    LocationCell = 2
    StartCell = 5
    DurationCell = 6
    EndCell = 7
    BusyCell = 8
    ReminderCell = 9
    BodyCell = 10

    ' Start looping at row 2
    r = 2

    ' Do/while set condition
    Do Until Trim(myWorksheet.Cells(r, 1).Value) = ""

        ' Create the Outlook session
        Set myOutlook = New Outlook.Application
        ' Set the namespace
        Set myNameSpace = myOutlook.GetNamespace("MAPI")
        ' Set the folder of your calendar
        ' To retrieve FolderID : Open Outlook -> Goto your Calendar -> Alt F11 -> Immediate Window -> Type "Print ActiveExplorer.CurrentFolder.EntryID" and hit enter
        Set myFolder = myNameSpace.GetFolderFromID("0000000000000000R1O5M2A8I7N000B4I6L2L6A5R9D00000000000000").Items.Add(olAppointmentItem)

        ' Set with block for the appointment configuration loop
        With myFolder
            ' Set Subject line of event
            .Subject = myWorksheet.Cells(r, SubjectCell).Value
            ' Set start time
            .Start = myWorksheet.Cells(r, StartCell).Value
            ' Set Duration of the appointment
            .Duration = myWorksheet.Cells(r, DurationCell).Value
            ' Set end time, if duration is not used
            '.End = myWorksheet.Cells(r, EndCell).Value
            ' Set Reminders or not
            If Cells(r, ReminderCell).Value > 0 Then
                .ReminderSet = True
                .ReminderMinutesBeforeStart = Cells(r, ReminderCell).Value
            Else
                .ReminderSet = False
            End If
           ' Set busy
            .BusyStatus = myWorksheet.Cells(r, BusyCell).Value
           ' Have the body of the event read as the decription from the leave form in Viewpoint
            .body = myWorksheet.Cells(r, BodyCell).Value
           ' Save event in owners calendar
            .Save
           ' End with block
        End With
       ' Move to next row
        r = r + 1
    ' Repeat do/while loop until condition is no longer valid
    Loop

    ' Confirmation message to avoid mistakes
    MsgBox ("Tâches ajoutées au calendrier")

End Sub

Sujet résolu !