[VBA OUTLOOK]Calendrier dans dossier publics

Question

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

cs_wyllou · Answer

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

cs_wyllou · Answer

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

[VBA OUTLOOK]Calendrier dans dossier publics

2 réponses

Votre réponse

Discussions similaires