Discussion :

[ThierryP73]

Bonjour,

Je souhaite compter les réunions / rendez-vous comportant une catégorie précise mais mes recherches sur le net n'ont pas donné grand-chose, à part ce code qui n'a pas d'erreur mais ne renvoie rien :

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
 
Sub FindAppts()
Dim myStart As Date
Dim myEnd As Date
Dim oCalendar As Outlook.Folder
Dim oItems As Outlook.Items
Dim oItemsInDateRange As Outlook.Items
Dim oFinalItems As Outlook.Items
Dim oAppt As Outlook.AppointmentItem
Dim strRestriction As String
 
myStart = Format(Date, "dd/mm/yyyy")
myEnd = DateAdd("d", 30, myStart)
 
Debug.Print "Start:", myStart
Debug.Print "End:", myEnd
 
'Construct filter for the next 30-day date range
strRestriction = "[Start] >= '" & myStart & "' AND [End] <= '" & myEnd & "'"
'Check the restriction string
Debug.Print strRestriction
Set oCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
Set oItems = oCalendar.Items
oItems.IncludeRecurrences = True
oItems.Sort "[Start]"
'Restrict the Items collection for the 30-day date range
Set oItemsInDateRange = oItems.Restrict(strRestriction)
'Construct filter for Subject containing 'team'
Const PropTag  As String = "http://schemas.microsoft.com/mapi/proptag/"
strRestriction = "@SQL=" & Chr(34) & PropTag _
    & "0x0037001E" & Chr(34) & " like '%Congé%'"
'Restrict the last set of filtered items for the subject
Set oFinalItems = oItemsInDateRange.Restrict(strRestriction)
'Sort and Debug.Print final results
oFinalItems.Sort "[Start]"
For Each oAppt In oFinalItems
    Debug.Print oAppt.Start, oAppt.Subject
Next
End Sub

Le code d'origine prenait des dates au format anglo-saxon, donc j'ai modifié le format de date au format français... mais pas mieux !
Donc si quelqu'un a une vague idée d'un semblant de début de piste, je suis preneur !!!

Bon week-end printanier !

ThierryP

[Oliv-]

Bonjour,
Essaye comme cela

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
Sub FindAppts()
    Dim myStart As Date
    Dim myEnd As Date
    Dim oCalendar As Outlook.Folder
    Dim oItems As Outlook.Items
    Dim oItemsInDateRange As Outlook.Items
    Dim oFinalItems As Outlook.Items
    Dim oAppt As Outlook.AppointmentItem
    Dim strRestriction As String
 
    Dim OL As Object
    If UCase(Application) = "OUTLOOK" Then
        Set OL = Application
    Else
        Set OL = CreateObject("outlook.application")
    End If
 
 
    myStart = Format(Date, "dd/mm/yyyy")
    myEnd = DateAdd("d", 30, myStart)
 
    Debug.Print "Start:", myStart
    Debug.Print "End:", myEnd
 
    'Construct filter for the next 30-day date range
    strRestriction = "[Start] >= '" & myStart & "' AND [End] <= '" & myEnd & "'"
    'Check the restriction string
    Debug.Print strRestriction
    Set oCalendar = OL.Session.GetDefaultFolder(olFolderCalendar)
    Set oItems = oCalendar.Items
    oItems.IncludeRecurrences = False
    oItems.Sort "[Start]"
    'Restrict the Items collection for the 30-day date range
    Set oItemsInDateRange = oItems.Restrict(strRestriction)
 
    'Construct filter for Subject containing 'team'
    Const PropTag As String = "http://schemas.microsoft.com/mapi/proptag/"
    ' 0x8021101E
 
' les 3 écritures ci-dessous fonctionnent
    'strRestriction = "[Catégories] = 'Congé (Jour de)'" ' nom exact de la catégorie
    'strRestriction = "@SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/Keywords" & Chr(34) & " like 'Congé (Jour de)'"
    strRestriction = "@SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/Keywords" & Chr(34) & " like '%Congé%'"
 
 
    'Restrict the last set of filtered items for the subject
    Debug.Print strRestriction
    Set oFinalItems = oItemsInDateRange.Restrict(strRestriction)
    'Sort and Debug.Print final results
    oFinalItems.Sort "[Start]"
    MsgBox oFinalItems.Count
    For Each oAppt In oFinalItems
        Debug.Print oAppt.Start, oAppt.Subject
    Next
End Sub

[ThierryP73]

Bonjour Oliv'

Ton code fonctionne, c'est parfait je vais pouvoir broder là autour !!!
Juste une 'tite question : où as-tu trouvé la syntaxe pour construire les filtres ?

Encore merci,

ThierryP

[Oliv-]

d'une part il y a l'aide et aussi j'utilise MFCMAPI qui permet de trouver les propriétés.