Discussion :

[basto]

Bonjour

Dans le calendrier standard, je souhaite lire l'ensemble des RDV entre 2 dates pour supprimer les pièces jointes.

Je sais sélectionner un RDV et supprimer sa pièce jointe mais je ne comprend pas comment faire une recherche globale des RDV.

D'avance merci pour votre aide.

A+ et bonnes fêtes de fin d'année

[basto]

Bonjour,

Comme on dit "on est jamais mieux servi que par soi même..." donc j'ai créusé, trouvé des pistes sur le forum via d'autres questions et comme je suis un mec sympa, voici ce que j'ai mis en place .... c'est noël si ca peut servir à d'autres ...

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
 
Sub CleanCalendar()
    ' permet de supprimer les pieces jointes des RDV entre 2 dates données.
    Dim LOutlookAppli As Outlook.Application
    Dim LRDV As AppointmentItem
    Dim objOutlookCalendar As Outlook.Items
    Dim objOutlookNameSpace As Outlook.NameSpace
    Dim DateDebut, DateFin As String
    Dim Lnbr_RDV, Lnbr_RDV_Att As Integer
    Dim Lmessage As String
 
    'DateDebut = "01/01/2011"
    'DateFin = "30/11/2011"
 
      ' On demande à l'utilsateur quelle date de début il souhaite
 
    DateDebut = InputBox("Date de début", "choix de la date de début de recherche", "01/01/" & Year(Now()))
 
    If (DateDebut = "") Then
      Exit Sub
    ElseIf Not IsDate(DateDebut) Then
        MsgBox "Vous devez saisir une date correcte jj/mm/aaaa !!!!", vbOKOnly
        Exit Sub
    End If
 
    ' On demande à l'utilsateur quelle date de fin il souhaite : Par défaut hier
 
    DateFin = InputBox("Date de fin", "choix de la date de fin de recherche", Format(Now() - 1, "dd/mm/yyyy"))
 
    If (DateFin = "") Then
      Exit Sub
    ElseIf Not IsDate(DateFin) Then
        MsgBox "Vous devez saisir une date correcte jj/mm/aaaa !!!!", vbOKOnly
        Exit Sub
    End If
 
    ' Initialisation des variables de gestion du calendrier
 
    Set LOutlookAppli = Outlook.Application
    Set objOutlookNameSpace = LOutlookAppli.GetNamespace("MAPI")
    Set objOutlookCalendar = objOutlookNameSpace.GetDefaultFolder(olFolderCalendar).Items
 
    objOutlookCalendar.Sort "[Start]"
    objOutlookCalendar.IncludeRecurrences = True
 
    Set objOutlookAppt = objOutlookCalendar.Find("[Start] >= '" & DateDebut & "' and [Start] <= '" & DateFin & "'")
 
    Lnbr_RDV = 0
    Lnbr_RDV_Att = 0
 
    While TypeName(objOutlookAppt) <> "Nothing"
       Lnbr_RDV = Lnbr_RDV + 1
 
       If objOutlookAppt.Attachments.Count <> 0 Then
         Lnbr_RDV_Att = Lnbr_RDV_Att + 1
         While (objOutlookAppt.Attachments.Count <> 0)
          objOutlookAppt.Attachments.Item(1).Delete
         Wend
 
         objOutlookAppt.Save
       End If
       Set objOutlookAppt = objOutlookCalendar.FindNext
    Wend
 
    Set objOutlookAppt = Nothing
    Set objOutlookCalendar = Nothing
    Set objOutlookNameSpace = Nothing
    Set LOutlookAppli = Nothing
 
    If Lnbr_RDV = 0 Then
        Lmessage = "Aucun RDV trouvé entre " & DateDebut & " et " & DateFin
    Else
        Lmessage = "Il y a " & Lnbr_RDV & " Rendez-vous entre " & DateDebut & " et " & DateFin
 
        If Lnbr_RDV_Att = 0 Then
            Lmessage = Lmessage & Chr(13) & "Aucun attachement trouvé"
        Else
            Lmessage = Lmessage & Chr(13) & "Les attachements de " & Lnbr_RDV_Att & " on été supprimés"
        End If
    End If
 
    MsgBox Lmessage
End Sub

Bonnes fêtes de fin d'année à tous

Bizz qu'aux filles