Rechercher un mail dans tout les dosier outlook

bonjour,

je voudrais savoir il est possible de faire un macro excel qui recherche un mail dans tout les dossier et sous dossier outlook pour répondre a un mal avec un sujet précis...

j'ai ce code qui me permet de faire avec le dossier "boite de reeption" mais il ne prend pas en copte les sous dossier ...

le code il est pas de moi je l'ai refistoller avec des bout de code trouve a gauche et a droite.

je vous remerciant d'avance.

voici mon code :

Sub maj_panne()

lst_mails.lst_mails ' la liste mail

Dim objNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim Item As Object
Dim sj As String
Dim le_mail As Variant
Dim ThisEmail As Outlook.MailItem

Set objNS = GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Set le_mail = CreateObject("outlook.application")

'~~~~RECHERCHER LE MAIL
'sj = "Déclaration de panne Sézane du " & Date & " N° de Ticket : " & variables.no_ticket ' le sujet de rechercher
sj = "TR: Amazon" ' le sujet de rechercher

With olFolder
    For i = 1 To .Items.Count
        If TypeOf .Items(i) Is Outlook.MailItem Then
          If .Items(i).Subject = sj Then
            n = i
          End If
        End If
    Next
End With

'~~~~LE CORPS DU MESSAGE

    Set ThisEmail = olFolder.Items(n).ReplyAll
    With olFolder.Items(n).ReplyAll

    End With

'le message est rédiger en HTML il faut donc utiliser des balise HTML pour la mise en page.
'ici la balise <br /> insérer comme du texte agis a la place de chr(10) qui sert a sauter une ligne

MonTexteEnPlus = "Client : structure" & "<br />" & _
                "Emplacement : " & variables.no_table & "<br />" & _
                "Matériel impacter : " & variables.materiel & "<br />" & _
                "La panne : " & variables.panne & "<br />" & _
                "Déclarer par : " & Environ("username") & "<br />" & _
                "Déclarer le : " & Date & " à " & Format(Now, "h\hmm") 'le corps du message

OuCommenceAdresse = InStr(1, ThisEmail.HTMLBody, "<BODY", vbTextCompare)
fin = InStr(OuCommenceAdresse + 5, ThisEmail.HTMLBody, ">") + 1
BaliseBody = Mid(ThisEmail.HTMLBody, OuCommenceAdresse, fin - OuCommenceAdresse)

ThisEmail.HTMLBody = Replace(ThisEmail.HTMLBody, BaliseBody, BaliseBody & MonTexteEnPlus)

ThisEmail.Display

End Sub