Bonjour,

je souhaiterais savoir comment récupérer le champ équivalent "Critère de périodicité" d'une réunion Outlook 2013 en VBA ? En effet ce champs n'apparait pas dans l'objet "RecurrencePattern" parce qu'il semble être une combinaison des différentes propriétés de cet objet, Néanmoins, on a la possibilité de visualiser ce champs lorsque l'on affiche les réunions du calendrier en mode liste. A priori il est en mode texte (Ex ->"Se produit tous les vendredi de 10h à 11h").

Savez-vous comment récupérer ce champs en VBA sans être obliger de le calculer à partir de l'état des propriétés de l'objet "recurrencePattern" ?

Le but est d'exporter les Réunions vers 1 fichiers excel en mentionnant ce champ.

J'ai commencé le code avec la fonction GetRecurrencePattern() qui me retourne un objet RecurrencePattern

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
 
Sub SallesReunionToExcel()
  Const SCRIPT_NAME = "Exporter le Planning des salles dans excel"
 
' nom du groupe calendrier
  Dim objPane As Outlook.NavigationPane
  Dim objModule As Outlook.CalendarModule
  Dim objGroup As Outlook.NavigationGroup
  Dim objNavFolder As Outlook.NavigationFolder
  Dim objSalle  As Folder
  Dim objFolder As Folder
 
  ' compteur de boucle
  Dim i As Integer
  Dim j As Integer
 
  'Objet outlook
 
  Dim olkFld As Object
  Dim olkGr  As Object
  Dim olkGrp As Object
  Dim olkSel As Object
  Dim olkLst As Object
  Dim olkApt As Object
  Dim olkpattern As Object
  Dim olkRecurType As Object
  Dim excApp As Object
  Dim excWkb As Object
  Dim excWks As Object
 
  Dim lngRow As Long
  Dim intCnt As Integer
 
  Dim Periodique As String
    Dim strfilename As String
 
  Set olkFld = Application.ActiveExplorer.CurrentFolder
  If olkFld.DefaultItemType <> olAppointmentItem Then
    MsgBox ("Erreur, la selection actuelle n'est pas de type calendrier")
  Else
   'Préparation du fichier excel
     Set excApp = CreateObject("Excel.Application")
     Set excWkb = excApp.Workbooks.Add()
     Set excWks = excWkb.Worksheets(1)
      'Créer les entêtes de colonnes Excel
     With excWks
       .cells(1, 1) = "Emplacement"
       .cells(1, 2) = "Objet"
       .cells(1, 3) = "Organisateur"
       .cells(1, 4) = "Créé"
       .cells(1, 5) = "Début"
       .cells(1, 6) = "Fin"
       .cells(1, 7) = "Categories"
       .cells(1, 8) = "Périodique ?"
       .cells(1, 9) = "Critere de Périodicité"
       .cells(1, 10) = "Jours par semaine"
       .cells(1, 11) = "Mois Par année"
       .cells(1, 12) = "Instance"
       .cells(1, 13) = "Periodicité"
       .cells(1, 14) = "durée"
       .cells(1, 15) = "Periodicité date de début"
       .cells(1, 16) = "Périodicité date de fin"
       .cells(1, 17) = "RecurrenceState"
 
     End With
 
    'Set objCalendar = Session.GetDefaultFolder(olFolderCalendar)
    Set objPane = Application.ActiveExplorer.NavigationPane
    Set objModule = objPane.Modules.GetNavigationModule(olModuleCalendar)
 
    With objModule.NavigationGroups
    'navigation des groupes de calendriers
    lngRow = 2
    For i = 1 To .Count
      Set objGroup = .Item(i)
      'on ne parcours pas le groupe Mes calendriers
      If objGroup <> "Mes calendriers" Then
        'parcours les salles de reunions du groupe en cours
        For j = 1 To objGroup.NavigationFolders.Count
          If objGroup.NavigationFolders.Item(j).IsSelected = True Then
            Set olkLst = objGroup.NavigationFolders.Item(j).Folder.Items
            olkLst.Sort "[Start]"
            olkLst.IncludeRecurrences = True
            For Each olkApt In olkLst
            'Exporte seulement les réunions (rendez vous)
              If olkApt.Class = olAppointment Then
                'Ajoute les colonnes pour chaque champs
                excWks.cells(lngRow, 1) = olkApt.Location
                excWks.cells(lngRow, 2) = olkApt.Subject
                excWks.cells(lngRow, 3) = olkApt.Organizer
                excWks.cells(lngRow, 4) = olkApt.CreationTime
                excWks.cells(lngRow, 5) = olkApt.Start
                excWks.cells(lngRow, 6) = olkApt.End
                excWks.cells(lngRow, 7) = olkApt.Categories
                excWks.cells(lngRow, 17) = olkApt.RecurrenceState
                Periodique = ""
                If olkApt.IsRecurring = True Then
                Periodique = "X"
                Set olkpattern = olkApt.GetRecurrencePattern()
                'Set olkRecurType = olkApt.GetRecurrencePattern.RecurrenceType
 
                With olkpattern
                  excWks.cells(lngRow, 8) = Periodique
                  excWks.cells(lngRow, 9) = .RecurrenceType
                  excWks.cells(lngRow, 10) = .DayOfWeekMask
                  excWks.cells(lngRow, 11) = .MonthOfYear
                  excWks.cells(lngRow, 12) = .Instance
                  excWks.cells(lngRow, 13) = .Occurrences
                  excWks.cells(lngRow, 14) = .Duration
                  excWks.cells(lngRow, 15) = .PatternStartDate
                  excWks.cells(lngRow, 16) = .PatternEndDate
 
                End With
                Set olkpattern = Nothing
                End If
 
                lngRow = lngRow + 1
                intCnt = intCnt + 1
 
              End If
            Next
            'excWkb.Close
          End If
        Next
      End If
    Next
 
 
    If intCnt = 0 Then
      MsgBox ("Il y a aucune réunion à exporter")
      excApp.Close
    Else
      strfilename = InputBox("Entrer le nom du fichier Excel (Chemin)pour exporter le planning des salles", SCRIPT_NAME, "c:\temp\" & Format(Now, "dd-mm-yyyy--hh-nn-ss-") & "fichier.xlsx")
      If strfilename <> "" Then
        excWks.Columns("A:Z").AutoFit
        excWkb.SaveAs strfilename
        MsgBox "Opération terminée -> un total de " & intCnt & " réunions a été exporté .", vbInformation + vbOKOnly, SCRIPT_NAME
        excApp.Visible = True
      End If
    End If
 
    End With
  End If
 
  Set objPane = Nothing
  Set objModule = Nothing
  Set objGroup = Nothing
  Set objNavFolder = Nothing
  Set objSalle = Nothing
  Set objFolder = Nothing
  Set olkFld = Nothing
  Set olkGr = Nothing
  Set olkGrp = Nothing
  Set olkSel = Nothing
  Set olkLst = Nothing
  Set olkApt = Nothing
  Set olkpattern = Nothing
  Set olkRecurType = Nothing
  Set excApp = Nothing
  Set excWkb = Nothing
  Set excWks = Nothing
 
End Sub
Cordialement.