BUG : Parcourir tous les fichiers s'arrête au premier fichier

Bonjour à toutes et tous,

J'ai actuellement une fonction permettant (normalement) de parcourir tous les mails Outlook d'un dossier, lorsque ces mails viennent d'un destinataire précis alors je le traite, pour enregistrer certaines données dans une page Excel. Et cela pour tous les mails.

Cependant le soucis que j'ai, c'est que lorsque je trouve un mail du bon destinataire, je le traite, mais après la boucle s'arrête.

Voici la fonction :

Sub Cherche_Infos()
Dim chemin As String, fichier As String, extens As String, inf As Infos, tablInfos() As String, I As Long
Dim objOL As Outlook.Application
Dim numLine As Integer
'nécessite d'activer la référence : Microsoft Outlook X.0 Object Library.
    Set objOL = CreateObject("Outlook.Application")
    chemin = "D:\PCN\mails\"         '***************** A ADAPTER *****************
    extens = "*.msg"
    fichier = Dir(chemin & extens)

    If fichier <> vbNullString Then

            'Création d'une nouvelle feuille temporaire
        ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(1)
        ThisWorkbook.Sheets(2).Name = SHEET_TMP

        Do
            ThisWorkbook.Sheets(SHEET_TMP).UsedRange.Clear
            I = I + 1
            ReDim Preserve tablInfos(1 To 3, 1 To I)
            inf = ExtraitInfos(chemin & fichier, objOL)
            If inf.Expediteur Like "Toto*" Or inf.Expediteur Like "Tata*" Then
                    tablInfos(1, I) = inf.Expediteur
                    tablInfos(2, I) = inf.Body
                    tablInfos(3, I) = inf.Pcn
                    Call exporter(inf.Body)
                    Call importer
                    Call traitementComposants_Produits
            End If
            fichier = Dir
        Loop While fichier <> vbNullString

    End If

Après le traitement du mail "valide" lorsqu'il y a la ligne fichier = dir, fichier prend une valeur nulle et du coup sort de la boucle.

Merci d'avance.

Cordialement,
Zapsalis

Bonjour Zapsalis,

Le mieux serait de déposer le fichier, car il manque un tas de sub et sans, nous ne pouvons tester et vérifier

A+

Bonjour,

Très bien, voici-le fichier ci-joint, j'ai enlevé certaines fonctions et sub pour confidentialité, le problème est quand même la.

Dès qu'il y a une correspondance au niveau des mails la procédure s'arrête.

Merci d'avance.

PS : LE dossier "D:\mails\" comporte juste des mails Outlook au format ".msg"

Bonjour Zapsalis

Je n'ai pas de problème particulier chez moi (testé sur 3 mails) en revanche, pour le test IF, mieux vaut mettre

If instr(1,inf.Expediteur,"toto",vbTextCompare)>0 Or instr(1,inf.Expediteur,"tata",vbTextCompare)>0  Then

Sinon, je m'aperçois qu'il n'y a aucune restitution des information dans le fichier !?
Vous remplissez la variable tableau TabInfos() mais n'en faites apparemment rien par la suite

De plus, une question que je me poserais toujours : quel intérêt d'enregistrer les mails individuellement dans un dossier ?
Un bon archivage et on retrouve tout ce que l'on veut dans Outlook

A+