Discussion :

[zoliv75]

Bonjour à tous,

Je suis débutant. Je voudrais faire une macro VBA qui parcourt tous les messages Outlook et qui détruit les messages non reçus ou émis l'année X.

Donc quelque chose du genre :

Pour tous les dossiers
Pour tous les messages
si message non reçu en 2009 et non émis en 2009
détruire le message

Pouvez-vous m'orienter vers le code VBA correspondant (surtout pour les initialisations et les 2 boucles).

Merci !

[Tempusago]

bon je suis pas un grand specialiste(je debute sur VBA outlook) mais j'ai fait une macro qui compte les mails dans des sous sous dossiers et qui met le resultat dans une feuille excel donc en adaptant un peu ca devrais etre possible de faire ce que vous voulez.

je precise que je suis pas capable de tout expliquer mais bon ca donnera un bon depart je pense.

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
 
sub Compte()
Dim objBook As Object
Dim objApp As Object
Dim objSheet As Object
Dim strPath As String
Dim strBook As String
Dim strSheet As String
Dim culumn As String
Dim feuil As String
Dim i As Integer
Dim test As Integer
test = 0
i = 0
culumn = "C"
'init ‡ modifier
strPath = "C:\NWLS\STAT\"
strBook = "SCAP.xls"
Set myNamespace = CreateObject("Outlook.Application").GetNamespace("MAPI")
Set fld = myNamespace.PickFolder
feuil = "feuill1"
strSheet = feuil
'traitement
Set objApp = CreateObject("excel.application")
Set objBook = objApp.Workbooks.Open(strPath & strBook)
'Set objSheet = objBook.worksheets(strSheet)
Set objSheet = objBook.Sheets(strSheet)
objApp.Visible = True   'si on veut visualiser
objSheet.Activate
'traite feuille
With objSheet
    For Each flds In fld.Folders
        For Each intermFlds In flds.Folders
            For Each subflds In intermFlds.Folders
                    For Each mail In subflds.Items
                            If DatePart("yyyy", mail.ReceivedTime) = 2009 Then
                                If test = 0 Then
                                    .cells(i + 2, 2 + DatePart("m", mail.ReceivedTime)).Value = ""
                                    test = 1
                                End If
                                .cells(i + 2, 2 + DatePart("m", mail.ReceivedTime)).Value = .cells(i + 2, 2 + DatePart("m", mail.ReceivedTime)).Value + 1
                            End If
                    Next
                    .cells(i + 2, 1).Value = intermFlds.Name
                    test = 0
                    i = i + 1
            Next
        Next
    Next
End With
End Sub

voila je pourrais eventuellement essayer de l'adapter mais je garantie rien.

[zoliv75]

Ouah merci, j'ai adapté ton code et j'ai réussi à faire ce que je voulais !