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

[Lolote83]

Bonjour à tous et à toutes,
Cela fait maintenant 3 jours que je parcours le Net à la recherche d'une solution.
Le sujet ne relevant pas spécifiquement d'Excel, je me suis permis de poster également sous l'intitulé Outlook sur ce même forum.
Peut être que des excelliens (nes) y parviendront. Désolé du coup pour le doublon.
De nombreuses questions ont effectivement déjà été posées mais aucune ne donne une solution acceptable.
J'essaye de créer des RDV depuis Excel sur un calendrier partagé.
- Je sais écrire sur le calendrier principal nommé "Calendrier"
- Je sais écrire sur un calendrier que j'ai partagé avec ma collègue nommé "Contrat" (mais elle ne peut pas écrire dessus)
- Ma collègue sait écrire sur un calendrier quelle a partagé avec moi nommé "TOTO" (mais je ne peux pas écrire dessus)

Ci dessous une copie d'écran qui résume ce qui est dessus
Lien supprimé
Tous les codes trouvés de droite et de gauche parlent de "calendrier partagés" mais je n'arrive pas à écrire sur "TOTO"
Vous trouverez donc dans le fichier joint,
- un onglet base qui résume ce qui est expliqué ci-dessus
- un onglet liens suivis qui montre une petite liste de liens que j'ai parcouru sur le sujet
- un module Mod_Ajout qui inscrit des RDV dans Calendrier (OK), dans Contrat (OK) mais pas dans Toto
- un module Mod_Test ou j'ai quelques tests
Je continue mes recherches mais si quelqu'un a déjà rencontré ce problème et a une solution, je suis preneur.
Par avance merci beaucoup
@+ Lolote83

 

[Lolote83]

Bonjour CHAGATTE,
Concernant ta demande, je ne sais pas.
J'ai passé tellement de temps pour essayer de resoudre mon problème que j'ai cherhé, cherché et encore cherché partout. Mais là, c'est la colle.
Désolé. Bon courage dans tes recherches.
@+ Lolote83

 

[chagatte]

Bonjour CHAGATTE,
Concernant ta demande, je ne sais pas.
J'ai passé tellement de temps pour essayer de resoudre mon problème que j'ai cherhé, cherché et encore cherché partout. Mais là, c'est la colle.
Désolé. Bon courage dans tes recherches.
@+ Lolote83

Merci Lolote83, je suis en train de regarder du côte de l'ID. Apparement en faisant folder.entryID, j'obtiens un identifiant unique pour l'objet calendrier qui m'intéresse. Donc je pense qu'après je peux ouvrir le calendrier à partir de l'ID. Si j'ai la solution je la poste

 

[Lolote83]

Merci pour ta recherche CHAGATTE.

 

[chagatte]

C'est bon, j'ai trouvé, voici la même fonction mais cette fois avec l'ID du calendrier (numéro unique) plutôt que le nom du calendrier :

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

 

[chagatte]

Et voici la fonction qui permet d'alimenter un combobox pour trouver les ID des calendriers :

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

 

[Lolote83]

Re bonjour CHAGATTE,
Merci pour la publication de ces informations.
A garder précieusement
@+ Lolote83

 

[Lolote83]

Salut CHAGATTE,
Je viens de tester ton code et ça plante dans le Sub AlimenterComboCalendar()

ID = ObjNavMod.NavigationGroups.Item(F).NavigationFolders.Item(G).Folder.EntryID

Ca marche chez toi ?
@+ Lolote83

 

[chagatte]

Chez moi ça fonctionne très bien et je l'ai testé chez d'autres personnes aussi. J'ai la référence Microsoft Outlook 16.0 d'activé. Tu as quoi comme numéro d'erreur ?

 

[Lolote83]

Salut CHAGATTE,
Merci pour ta réponse.
Je viens de tester au bureau et finalement, ici, je n'ai pas d'erreur.
Je referais donc un test à la maison
Merci pour cette ressource du coup
@+ Lolote83