Discussion :

[ZeitnotZatopek]

Bonjour et merci d'avance de votre aide.

Je dois sauvegarder les pièces jointes sous la condition qu'elles aientt dans leur titre "Toto " puis ensuite archiver les Emails dont la pièce jointe a été sauvegardée.
Dand le code suivant, il reste toujours dans la boite réception quelques Emails.
Pourquoi?
merci d'avance.

Inspiré, en partie de programmes du forum voici le code :

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
Sub Archivage()
 
On Error Resume Next
Dim j As Integer
Dim MonApply As Outlook.Application
Dim EMAIL As Outlook.MailItem
Dim MonNameSpace As Outlook.NameSpace
Dim Dossiers As Outlook.MAPIFolder
Dim PceJointe As Outlook.Attachment
Set MonApply = CreateObject("Outlook.Application")
Set MonNameSpace = MonApply.GetNamespace("MAPI")
Set Dossiers = MonNameSpace.Folders("Dossiers personnels")
Set Destination = Dossiers.Folders("Archives")
Set Breception = MonNameSpace.GetDefaultFolder(olFolderInbox)
 
i = 0
j = 0
 
For Each EMAIL In Breception.Items
 
        If Not EMAIL.Attachments.Count = 0 Then
 
                For i = 1 To EMAIL.Attachments.Count
 
                     Set PceJointe = EMAIL.Attachments(i)
 
                     j = j + 1
 
                     Nom = PceJointe.DisplayName
 
                     If Nom Like "*TOTO*" Then
 
                        PceJointe.SaveAsFile "C:\Resultats\" & PceJointe.DisplayName                        
 
 
                        Set Destination = Dossiers.Folders("Archives")
 
                        Set EMAIL = EMAIL.Move(Destination)
 
                        Set PceJointe = Nothing
 
                    End If
 
                Next i
 
        End If
 
Next EMAIL
 
 
 
    Set PceJointe = Nothing
 
    i = 0
    Set MonApply = Nothing
    Set MonNameSpace = Nothing
    Set Dossiers = Nothing
    Set EMAIL = Nothing
 
End Sub

[red_one]

bonjour Mr.


NB:


J'ai testé ton code il marche tré bien

j'ai changé seulemnt le nom de fichier ou les messages seront enregistré

[Luicoaat]

Bonjour,

Comment faire pouer appliquer cette macro à une boite au lettre commune??

Merci