[VBA OUTLOOK]Calendrier dans dossier publics

Bonjour tout le monde,

Je viens vous soliciter car j'ai un souci avec l'exportation sous Excel de mes calendriers qui sont dans mes dossiers publics.

Je détail un peu quand même.
Je suis sous Office 2007.

Dans Outlook il y un module Dossiers publics avec à l'intérieur un dossier s'appelant Tous les dossiers publics; et moi dans ce dossier Tous les dossiers publics, j'ai un dossier qui s'appelle Calendrier de groupe, contenant plusieurs calendriers publics.

J'ai donc trouvé sur Internet du code permettant de récupérer les données et de les saisir pour chaque calendriers sur une feuille différente.

Se code fais un boucle sur le dossier Calendrier de groupe, pour voir tous les calendriers publics, et une boucle sur les items qui correspond au rendez-vous.

Mon problème est que j'arrive à récupérer les deux premiers calendrier et ensuite ma boucle ne passe pas au troisième mais répète le deuxième, et je ne comprend pas pourquoi car j'utilise les fonctions GetFirst et GetNext.

---

Voici le code:

Sub ExportationDossiersPublics()

'Déclarations des variables
Dim objApplication       As New Outlook.Application
Dim objNameSpace         As Outlook.Namespace
Dim fdrDossierPublic     As Outlook.MAPIFolder
Dim fdrCalendGroupe      As Outlook.MAPIFolder

Dim oCalendar            As Outlook.Items

Dim oRDV                 As Outlook.AppointmentItem




Set objApplication = Outlook.Application
Set objNameSpace = objApplication.GetNamespace("MAPI")
Set fdrDossierPublic = objNameSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders)


Set fdrCalendGroupe = fdrDossierPublic.Folders.Item(1)
Debug.Print fdrCalendGroupe.Name
Debug.Print fdrCalendGroupe.Folders.Count

Set oCalendar = fdrCalendGroupe.Folders.GetFirst.Items



'oCalendar renvoie les calendrier du dossier Calendrier de groupe


Dim nbcalendrier As Integer
    nbcalendrier = fdrCalendGroupe.Folders.Count

   
   
   
        For idcalendrier = 1 To nbcalendrier
            '-------------------Création de feuille-------------
            'récupération du nom du calendrier
            Dim nomcalendrier As String
                'nomcalendrier = oCalendar
              
             
          
             Dim feuille As Worksheet
                'création d'une nouvelle feuille pour chaque calendrier
                Set feuille = Application.Sheets.Add(, Sheets(Sheets.Count))
                'feuille.Name = nomcalendrier
             '******************************************************************************
               
           
           
           
           
            '-------------------------- Affichage légende-------------------
          
               
                'saisie de la première ligne de titre des colonnes
                feuille.Cells(1, 1) = "Sujet"
                feuille.Cells(1, 2) = "Contenu"
                feuille.Cells(1, 3) = "Localisation"
                feuille.Cells(1, 4) = "Début"
                feuille.Cells(1, 5) = "Fin"
                feuille.Cells(1, 6) = "Durée"
             '******************************************************************************
               
               
     
               
                '---------------------------Remplissage des feuilles---------------------
               
                 'nombre de rendez vous dans le calendrier
            Dim nbitem As Integer
              
              
                nbitem = oCalendar.Count
                'oRDV   renvoie les événements present dans le calendrier oCalendar
                Set oRDV = oCalendar.GetFirst
               
               
               
            For iditem = 1 To nbitem

                feuille.Cells(iditem + 1, 1) = oRDV.Subject
                feuille.Cells(iditem + 1, 2) = oRDV.Body
                feuille.Cells(iditem + 1, 3) = oRDV.Location
                feuille.Cells(iditem + 1, 4) = oRDV.Start
                feuille.Cells(iditem + 1, 5) = oRDV.End
                feuille.Cells(iditem + 1, 6) = oRDV.Duration

               
                'Redimmensionner les colonnes automatiquement à la largeur du texte
                Application.Cells.Columns.AutoFit
                Application.Cells.VerticalAlignment = xlVAlignCenter
               
                'passer au suivant
              
                Set oRDV = oCalendar.GetNext
               
               
               
               
            Next iditem
          
         Set oCalendar = fdrDossierPublic.Folders.Item(1).Folders.GetNext.Items
        
        Next idcalendrier
        '******************************************************************************
       
       
       
       
       
    '-------------------------Suppression de la feuille par défaut--------------
     Dim nbfeuille As Integer
     'compte le nombre de feuilles
     nbfeuille = Sheets.Count
     'desactivation de la fenetre de confirmation de suppression
     Application.DisplayAlerts = False
     'Suppression de la première feuille par défaut
     Application.Worksheets(nbfeuille - (nbfeuille - 1)).Delete
     'desactivation de la fenetre de confirmation de suppression
     Application.DisplayAlerts = True
   '******************************************************************************

  
  
  
    'Destruction des variables
    Set objApplication = Nothing
    Set objNameSpace = Nothing
    Set fdrDossierPublic = Nothing
    Set expActive = Nothing
   
   
End Sub

---

Si quelqu'un aurait la solution pour me dépatouiller ça serait génial.

Merci d'avance!


Wyllou

Rebonjour à tous,
J'ai poussé un peu le test.
J'ai fais un code affichant le nom des dossiers dans l'autre hiérarchique.
Voilà le code

---

Sub export()


Dim objApplication       As New Outlook.Application
        Set objApplication = Outlook.Application

Dim objNameSpace         As Outlook.Namespace
        Set objNameSpace = objApplication.GetNamespace("MAPI")




Dim DossierCalGroupe      As Outlook.MAPIFolder
        Set DossierCalGroupe = objNameSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders.Item(1)
       
        Debug.Print DossierCalGroupe.Folders.Count
       
       
Dim LeCalendrier          As Outlook.MAPIFolder
        Set LeCalendrier = DossierCalGroupe.Folders.GetFirst
        Debug.Print LeCalendrier.Name

        Set LeCalendrier = DossierCalGroupe.Folders.GetNext
        Debug.Print LeCalendrier.Name

        Set LeCalendrier = DossierCalGroupe.Folders.GetNext
        Debug.Print LeCalendrier.Name
End Sub

---

Rien de bien compliqué, et plutot logique, sauf qu'à l'affichage j'ai le nom de mon premier calendrier, puis celui du deuxième , mais au lieu d'avoir le nom du troisième ensuite, et bin c'est le nom du deuxième qui revient.

 38
Art Floral
BAC CGEA 1
BAC CGEA 1

Je comprend pas. Normalement avec GetNext, il devrait passer au suivant.

Si quelqu'un à une explication à ça. Merci


Wyllou

Bonjour  tout le monde,
Je viens voir si mon sujet inspire, mais apparemment non , snif :(
Tant pis

Wyllou