Option Explicit
'La boite de réception, la boite des éléments supprimés et tous leurs
'sous dossiers sont pris en compte.
Sub ExportePiecesJointes(Adresse$)
Dim Ol As New Outlook.Application
Dim Ns As Outlook.Namespace
Dim Dossier As Outlook.MAPIFolder
Set Ns = Ol.GetNamespace("MAPI")
Set Dossier = Ns.Folders(1)
SearchFolders Dossier, Adresse
End Sub
Private Sub SearchFolders(ByVal Fld As Outlook.MAPIFolder, Adresse$)
Dim y As Integer, nom$, Email$
Dim OLmail As Outlook.MailItem
Dim pceJointe As Outlook.Attachment
Dim SousDossier As Outlook.MAPIFolder
Dim DossierArchives As Outlook.MAPIFolder
'Recherche les sous-répertoire dans ton dossier
For Each SousDossier In Fld.Folders
'Si le sous-répertoire = "Pays"
If SousDossier.DefaultItemType = 0 And SousDossier = "Boîte de réception" Then
'On regarde dans tous les mails
For Each OLmail In SousDossier.Items
'Si l'adresse du mail correspond à A1
If OLmail.SenderEmailAddress = Adresse Then
'On récupère affiche le mail
OLmail.Display
End If
'On passe au mail suivant
Next OLmail
End If
'On passe au sous-répertoire suivant
SearchFolders SousDossier, Adresse
Next SousDossier
End Sub