XL 2016 Inscrire des RDV dans Outlook (calendrier partagé) via Excel macro

Sub AjoutDansCalendrier2(xid, xTitre, xDateDeb, xHeurDeb, xDuree, xBody)
    '---------------------------------------------------------------------------------------
    '                                                   Création d'un RDV sur Agenda OUTLOOK
    '---------------------------------------------------------------------------------------
    Dim olapp As Outlook.Application
    Dim ObjNS As Outlook.Namespace

    Set olapp = CreateObject("outlook.application")
    Set ObjNS = olapp.Session
    
        On Error GoTo 0
        '---------------------------------------------------------
        '                                          Création du RDV
        '---------------------------------------------------------
        Dim ObjRDV As Outlook.AppointmentItem
        
        Set ObjRDV = ObjNS.GetFolderFromID(xid).Items.Add
        xStart = xDateDeb & " " & Deux(Hour(xHeurDeb)) & ":" & Deux(Minute(xHeurDeb)) & ":00"
        With ObjRDV
            .Subject = xTitre
            .Body = xBody
            .Start = xStart
            .Duration = xDuree                      'Valeur entière (exemple 30) exprimée en minutes
            .ReminderMinutesBeforeStart = 0
            .ReminderSet = True
            .Display                                'Mettre en commentaire après mise au point
        End With
 
End Sub

Sub AlimenterComboCalendar()

    Dim olapp As Outlook.Application
    Dim ObjNS As Outlook.Namespace
    Dim ObjExpCal As Outlook.Explorer
    Dim ObjNavMod As Outlook.CalendarModule
    Dim ObjNavCalPart As Outlook.NavigationFolders
    Dim ObjNavFolder As Outlook.NavigationFolder
    Dim FolderPartage As Outlook.Folder
    Dim F
    Dim xTrouve As Boolean

    Set olapp = CreateObject("outlook.application")
    Set ObjNS = olapp.Session
    Set ObjExpCal = ObjNS.GetDefaultFolder(olFolderCalendar).GetExplorer
    Set ObjNavMod = ObjExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)


    '--------------------------------------------------------------------------------------
    '     Parcours la liste des familles de calendrier et les calendriers de chaque famille
    '--------------------------------------------------------------------------------------
    xTrouve = False
    xNbrFamCal = ObjNavMod.NavigationGroups.Count
    For F = 1 To xNbrFamCal
        xNbrSousCal = ObjNavMod.NavigationGroups.Item(F).NavigationFolders.Count
        For G = 1 To xNbrSousCal
            xNomFamilleCal = ObjNavMod.NavigationGroups.Item(F).Name
            xNomCalendrier = ObjNavMod.NavigationGroups.Item(F).NavigationFolders.Item(G).DisplayName
            ID = ObjNavMod.NavigationGroups.Item(F).NavigationFolders.Item(G).Folder.EntryID
                
            Me.ComboBox_Outlook.AddItem (G & "-->" & xNomFamilleCal & "-->" & xNomCalendrier & "-->" & ID)
                    
        Next G
    Next F

    
End Sub