Bonjour

J'ai un programme où j'extrait des pièces jointes spécifiées à la date du jour, sans les trier vraiment. maintenant j'aimerai pouvoir les trier et choisir quel mail je veux extraire. J'ai donc fait un userform avec différents optionbutton pour spécifier lesquelle je veux. j'ai intégré le principe à mon code de départ mais je n'arrive pas à dépasser un point. Dans mon code de départ, je parcourais l'ensemble des mails reçu à ce jour et s'il respecte les dites contitions il extrait. Maintenant je fais une référence à des noms précis, donc il parcours les mails comme d'hab mais si le nom que je veux est le dernier mail de la liste, lorsqu'il revient à la boucle de la liste que je veux (donc au second nom) vu qu'il est déjà en bas de la liste de nom il ne recherche pas. Je vous copie mon 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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
If UserForm1.OptionButton1 = True Then
 
 
                    'On Error GoTo TraiteErreur
 
                    ' Création de la session Notes
                                        'Ouverture d'une session NOTES
                    'Dim motpasse As String
 
 
                    Call Session.Initialize(motpasse) 'si pas de passwd pas de parametre pour initialize
                    Set dir = Session.GetDbDirectory("")
 
                    Set db = dir.OpenMailDatabase
 
'                    Dim MailDoc As Object 'The mail document itself
'                    Dim MailFile As Object
'
'                    Dim item As Object
'                    Dim obj As Variant
'                    Dim Compteur As Integer
 
 
 
                    test_date = InputBox("Date des mails a extraire (dd/mm/yyyy):", "DATE EXTRACT")
 
                    Set MailFile = db.GetView("valid comptable")
                    Set MailDoc = MailFile.GetLastDocument
 
                    While Range("E21").Offset(i, 0) <> "Brique 2"
 
                                        ptfop = Range("E21").Offset(i, 0)
                                        ptfh = Range("E21").Offset(i, 0) & "_1"
 
 
 
                    Do While Not (MailDoc Is Nothing)
 
                    Set item = MailDoc.GetFirstItem("Body")
                        If (item.Type = RICHTEXT) Then
                            If Not IsEmpty(item.EmbeddedObjects) Then
                                For Each obj In item.EmbeddedObjects
 
 
 
                                    If (obj.Type = EMBED_ATTACHMENT) And (VBA.Right(obj.Name, 8) = ptfop & ".xls" Or VBA.Right(obj.Name, 10) = ptfh & ".xls") And Format(test_date, "yyyymmdd") = Format(item.LastModified, "yyyymmdd") And (VBA.Left(obj.Name, 6) = "JOURSR" Or VBA.Left(obj.Name, 5) = "HISIN" Or VBA.Left(obj.Name, 6) = "JOUROP") Then
'                                              Dim objFSO, objDossier, objFichier
'                                              Dim Repertoire, NomFichierTxt
                                                test_fichier_present = False
 
                                              Repertoire =EXTRACT_MAIL"
                                              Set objFSO = CreateObject("Scripting.FileSystemObject")
                                              Set objDossier = objFSO.GetFolder(Repertoire)
 
 
                                              If (objDossier.Files.Count > 0) Then
                                                 For Each objFichier In objDossier.Files
                                                    If objFichier.Name = obj.Name Then
                                                        test_fichier_present = True
                                                    End If
                                                 Next
                                               End If
 
                                              Set objDossier = Nothing
                                              Set objFSO = Nothing
 
                                        If test_fichier_present = False Then
                                            Call obj.ExtractFile("EXTRACT_MAIL\" + obj.Name)
                                        End If
                                    End If
                                Next
                            End If
                        End If
 
                        Set MailDoc = MailFile.GetPrevDocument(MailDoc)
                        If DateDiff("d", Format(Now() - 15, "dd/mm/yy"), Format(item.LastModified, "dd/mm/yy")) < 0 Then
                        Set MailDoc = Nothing
                        End If
                    Loop
 
                          i = i + 1
                     Wend
 
                     Set object = Nothing
                        Set rtitem = Nothing
                        Set doc = Nothing
                        Set db = Nothing
                        Set Session = Nothing
                        Set MailFile = Nothing
                    Set MailDoc = Nothing
 
 
        End If

Voilà si quelqu'un voit une solution avec des yeux neuf et reculés peut être.

merci