Bonjour à tous,
Je cherche a parcourir tous les mails d'une boite et les archiver, jai fait le code de test suivant:
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
 
Sub archiver()
 
    Dim appOl As New Outlook.Application
    Dim SubFolder As MAPIFolder
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
 
    Dim i As Integer
    Dim nb_mail As Integer
    Dim nb_archives As Integer
    nb_mail = 0
    nb_archives = 0
 
 
    Set ns = GetNamespace("MAPI")
    Set MaBoite = ns.Stores("reception.test@gmail.com")
    Set Inbox = MaBoite.GetDefaultFolder(olFolderInbox)
 
    heure_debut = Time()
 
    For Each Item In Inbox.Items
        nb_mail = nb_mail + 1
       ' MsgBox (Item.Subject)
 
 
             ' on parcourt les destinteires
              Set recips = Item.Recipients
            For Each recip In recips
                Set pa = recip.PropertyAccessor
                'MsgBox (recip.Name & " " & recip.Address)
            Next
 
            ' si le mail est LU et date de PLUS DE 60 MINUTES
            If Item.UnRead = False And _
               Item.ReceivedTime < DateAdd("n", -60, Now) Then
                nb_archives = nb_archives + 1
                ' on archive en fonction du sujet du mail
                    Select Case Item.Subject
 
                    Case "TOTO"
                        Set DossierDesti = Inbox.Folders("TOTO")
                    Case "TITI"
                        Set DossierDesti = Inbox.Folders("TITI")
                    Case "TUTU"
                        Set DossierDesti = Inbox.Folders("TUTU")
                    Case Else
                        Set DossierDesti = Inbox.Folders("Inconnu")
 
                    End Select
 
 
                Item.Move DossierDesti
 
            End If
 
    Next Item
     heure_fin = Time()
    secondes = DateDiff("s", heure_debut, heure_fin)
    duree_txt = (secondes \ 60) & " Min" & (secondes - (secondes \ 60) * 60) & " Sec"
    MsgBox (nb_mail & " mails verifies et " & nb_archives & " mail archives en " & duree_txt)
 
 
End Sub
Ca semble fonctionner ds le cas nominal mais si un ou plusieurs mails arrivent pendant l'exécution du code, je pense que mon code
Code : Sélectionner tout - Visualiser dans une fenêtre à part
  For Each Item In Inbox.Items
déconne car l'arrivée d'un mail décale tout car la liste des mails change , est ce que j'utilise la bonne méthode ?
Comment faire ?
Merci de votre aide