Bonjour à tous,

Je suis débutant en VBA et je voudrais savoir comment faire pourqu'une portion de code se répète deux foix dans une même fonction et que cela reste "propre" ...

Dans l'exemple ci dessous il s'agit de scanner le dossier principal Outlook et de créer des enregistrements aussi bien en cherchant dans le courrier envoyé comme dans celui reçu grâce à un filtre (adresses mails clients).

La première portion du code fonctionnait à merveille mais en voulant traiter la deuxième partie c.à.d réexécuter une recherche des mails mais cette fois en utilisant le dossier Ol_Items.SenderEmailAdress je me suis mélangé les pinceaux ...

Je suis sûr qu'il doit y avoir un truc plus simple à faire dans ce code sans avoir à répéter celui ci, merci d'avance pour vos corrections !

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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
Public Function ImportMailsOutlook()
 
    Dim db As Database
    Dim strAttachment As String
    Dim strSQL1 As String
    Dim strSQL2 As String
    Dim rsMail As DAO.Recordset
    Dim blnMailTrouvé1 As Boolean
    Dim blnMailTrouvé2 As Boolean
    Dim strMail1 As String
    Dim strMail2 As String
 
 
    Dim Ol_App As New Outlook.Application
    Dim Ol_Mapi As Outlook.NameSpace
    Dim Ol_Folder As Outlook.MAPIFolder
    Dim Ol_Items As Outlook.MailItem
    Dim Ol_Attach As Outlook.Attachment
 
    Set rsMail = CurrentDb.OpenRecordset("Mails importés outlook")
    Set Ol_Mapi = Ol_App.GetNamespace("MAPI")
    Set Ol_Folder = Ol_Mapi.GetDefaultFolder(olFolderInbox)
    Set db = CurrentDb
 
    For Each Ol_Items In Ol_Folder.Items
 
        strMail1 = Ol_Items.To
 
        strSQL1 = "SELECT NumContact FROM Contacts" _
            & " WHERE Mail1 = """ & strMail1 & """" _
            & " OR Mail2 = """ & strMail1 & """" _
            & " OR Mail3 = """ & strMail1 & """"
 
 
        With db.OpenRecordset(strSQL1)
         blnMailTrouvé1 = (.EOF = False)
 
        End With
 
        If blnMailTrouvé1 Then
 
            For Each Ol_Attach In Ol_Items.Attachments
                strAttachment = strAttachment & Ol_Attach.DisplayName & vbCrLf
            Next Ol_Attach
 
            With rsMail
               .AddNew
               !BCC = Ol_Items.BCC
               !Categories = Ol_Items.Categories
               !CC = Ol_Items.CC
               !ConversationTopic = Ol_Items.ConversationTopic
               !CreationTime = Ol_Items.CreationTime
               !HTMLBody = Ol_Items.HTMLBody
               !LastModificationTime = Ol_Items.LastModificationTime
               !ReceivedByName = Ol_Items.ReceivedByName
               !ReceivedOnBehalfOfName = Ol_Items.ReceivedOnBehalfOfName
               !ReceivedTime = Ol_Items.ReceivedTime
               !SenderName = Ol_Items.SenderName
               !Sent = Ol_Items.Sent
               !SentOn = Ol_Items.SentOn
               !SenderAddress = Ol_Items.SenderEmailAddress
               !Size = Ol_Items.Size
               !Subject = Ol_Items.Subject
               !To = Ol_Items.To
               !UnRead = Ol_Items.UnRead
               !Attachments = strAttachment
               .Update
            End With
            strAttachment = ""
        End If
    Next Ol_Items
    rsMail.Close
 
 
    Set rsMail = Nothing
    Set Ol_Attach = Nothing
    Set Ol_Items = Nothing
    Set Ol_Folder = Nothing
    Set Ol_Mapi = Nothing
    Set Ol_App = Nothing
 
    For Each Ol_Items In Ol_Folder.Items
    strMail2 = Ol_Items.SenderEmailAddress
 
       strSQL2 = "SELECT NumClient FROM Clients" _
            & " WHERE Mail1 = """ & strMail2 & """" _
            & " OR Mail2 = """ & strMail2 & """" _
            & " OR Mail3 = """ & strMail2 & """"
 
            With db.OpenRecordset(strSQL2)
         blnMailTrouvé2 = (.EOF = False)
 
        End With
 
        If blnMailTrouvé2 Then
 
            For Each Ol_Attach In Ol_Items.Attachments
                strAttachment = strAttachment & Ol_Attach.DisplayName & vbCrLf
            Next Ol_Attach
 
            With rsMail
               .AddNew
               !BCC = Ol_Items.BCC
               !Categories = Ol_Items.Categories
               !CC = Ol_Items.CC
               !ConversationTopic = Ol_Items.ConversationTopic
               !CreationTime = Ol_Items.CreationTime
               !HTMLBody = Ol_Items.HTMLBody
               !LastModificationTime = Ol_Items.LastModificationTime
               !ReceivedByName = Ol_Items.ReceivedByName
               !ReceivedOnBehalfOfName = Ol_Items.ReceivedOnBehalfOfName
               !ReceivedTime = Ol_Items.ReceivedTime
               !SenderName = Ol_Items.SenderName
               !Sent = Ol_Items.Sent
               !SentOn = Ol_Items.SentOn
               !SenderAddress = Ol_Items.SenderEmailAddress
               !Size = Ol_Items.Size
               !Subject = Ol_Items.Subject
               !To = Ol_Items.To
               !UnRead = Ol_Items.UnRead
               !Attachments = strAttachment
               .Update
 
            End With
            strAttachment = ""
        End If
    Next Ol_Items
 
    rsMail.Close
 
 
    Forms![Mails]![sf mails importés outlook].Form.Requery
    MsgBox "Les données ont été importées"
 
 
 
    Set rsMail = Nothing
    Set Ol_Attach = Nothing
    Set Ol_Items = Nothing
    Set Ol_Folder = Nothing
    Set Ol_Mapi = Nothing
    Set Ol_App = Nothing
 
End Function