Bonjour,

J'ai une macro qui me permet de trouver un mail dans ma boite de réception dans un sous dossier spéfique, or je souhaiterais que ma macro cherche dans tout les sous dossier présent dans la boite de réception
voici mon bout de 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
Dim maPj As Object
Dim monMail As Object
Dim MonApp As Object, ns As Object
Dim MonDossier As Object, LesMails As Object
Dim wk As Workbook
Dim MonClasseur As Workbook
 
Dim ladate As Date
Dim ladate_2
Dim monchemin As String
Dim m As Long
 
 ladate = Feuil25.Range("C2").Value
  ladate_2 = WorksheetFunction.Proper(Format(ladate, "dd Mmm yyyy"))
  MsgBox ladate_2
 
On Error Resume Next: Set MonApp = GetObject(, "Outlook.Application"): On Error GoTo 0
If MonApp Is Nothing Then Set MonApp = CreateObject("Outlook.Application")
 
Set ns = MonApp.GetNamespace("MAPI")
 
Set MonDossier = ns.Folders("******@axa-im.com").Folders("Boîte de réception").Folders("ctpy").Folders("******")
'Set MonDossier = ns.GetDefaultFolder(olFolderInbox)
'mail Barclays
 
Set LesMails = MonDossier.Items
    For m = 1 To LesMails.Count
          If LesMails(m).Subject = "*********" as at" & ladate_2 Then
         If LesMails(m).SenderEmailAddress = "*****@****.com" Then
            Set maPj = LesMails(m).Attachments
 
            monchemin = "G:\OSSM\*****
            'maPj.SaveAsFile MonChemin & "test".xls"
             maPj(1).SaveAsFile monchemin & "test.xls"
           MsgBox "Mail trouvé"
            Exit For
        End If
     End If
    Next m