Exit sub ne clot pas la procedure

Bonjour,

Pour la 1ere fois je demande de l´ aide en live.... Jusqu´a maintenant j´ ai toujours trouvé notamment sur ce forum, mais là je pioche grave

Voilà, j´ai une procédure qui teste si un dossier existe, s´il le trouve, je récupère le chemin et je met fin à la procédure avec un exit sub.

Or si l’instruction va bien sur exit sub, mais la boucle for reprend comme si de rien n´était...

Je pense que c´est à cause de la sous routine, mais j´ignore comment m´en passer ?

En vous remerciant par avance, cordialement

Le code...

Sub ArborescenceRepertoire()
  Racine = "C:\00_box"                    ' Répertoire courant
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set DossierRacine = fs.getfolder(Racine)
  LitDossier DossierRacine, 1
End Sub

Sub LitDossier(ByRef Dossier, ByVal Niveau)
   For Each d In Dossier.SubFolders
   LitDossier d, Niveau + 1
If d Like "*ici_01*" Then
    MsgBox "trouvé " & d
chemin = d
    Exit Sub
      Else
End If

   Next
End Sub

Bonjour,

Ce n'est pas DossierRacine ... c'est Dossier... Il faut que l'un corresponde à l'autre.

  LitDossier DossierRacine, 1
End Sub

Sub LitDossier(ByRef Dossier, ByVal Niveau)

Bastr

Hello Bastr,

Si je corrige DossierRacine par Dossier j´ai erreur 424 objet requis...

En soit cela fonctionne, mais impossible de quitter la routine quand le if est vrai malgré exit sub

merci pour votre aide

Bonjour,

Pour sortir de ta boucle récursive, il faut positionner une variable booléenne au niveau du module, comme ceci :

Dim sortie As Boolean

Sub ArborescenceRepertoire()
  Racine = "C:\00_box"                    ' R?pertoire courant
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set DossierRacine = fs.getfolder(Racine)
  LitDossier DossierRacine, 1
End Sub

Sub LitDossier(ByRef Dossier, ByVal Niveau)
    For Each d In Dossier.SubFolders
        If sortie Then Exit Sub
        LitDossier d, Niveau + 1
        If d Like "*ici_01*" Then
            MsgBox "trouv? " & d
            chemin = d
            sortie = True
            Exit Sub
        End If
   Next

End Sub

Par ailleurs, je ne vois pas l'intérêt de cette instruction à partir du moment où Racine n'est pas un fichier

 Set DossierRacine = fs.getfolder(Racine)

Bonjour thev,

Merci pour votre réponse, malheureusement le problème persiste, une fois la condition vrai, la boucle reprend...

Ce code est adapté a mon usage et il est vrais que je ne le comprend pas tout.

Finalement je me suis rabattu sur un autre code qui fonctionne selon mes besoins.

Toutefois, je peine à comprendre l´utilité de faire 2 procédures pour si peut, est t´il possible de n´avoir qu ´une proc afin de facilité l´intégration et surtout d´en comprendre le fonctionnement ?

Peut être dois-je ouvrir un autre post pour cette question

Cordialement

Sub test_01()

    TousLesDossiers "C:\00_box\", 0

End Sub

Sub TousLesDossiers(LeDossier$, Idx As Long)
    Dim FSO As Object, Dossier As Object
    Dim sousRep As Object, Flder As Object
    Dim Trouve_chemin As String
    Dim Cherch_doss As String

  Cherch_doss = "ici"

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Dossier = FSO.GetFolder(LeDossier)

    'examen du dossier courant
    For Each Flder In Dossier.SubFolders
        Idx = Idx + 1
        Trouve_chemin = Flder.Path

        If Trouve_chemin Like "*" & Cherch_doss & "*" Then
            MsgBox "Trouvé le chemin " & Trouve_chemin
            Exit Sub
        End If
    Next

    'traitement récursif des sous dossiers
    For Each sousRep In Dossier.SubFolders
        TousLesDossiers sousRep.Path, Idx
    Next sousRep
    Set FSO = Nothing

End Sub

Swissmad a écrit :

Merci pour votre réponse, malheureusement le problème persiste, une fois la condition vrai, la boucle reprend...

Non, si vous avez bien défini la variable booléenne au niveau du module et non au niveau de la procédure "Sub" ?

oui, comme ceci...

Dim sortie As Boolean

Sub ArborescenceRepertoire()
  Racine = "C:\00_box"                    ' Répertoire courant
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set DossierRacine = fs.GetFolder(Racine)
  LitDossier DossierRacine, 1
End Sub

Sub LitDossier(ByRef Dossier, ByVal Niveau)

   For Each d In Dossier.SubFolders
   LitDossier d, Niveau + 1
If d Like "*ici_01*" Then
    MsgBox "trouvé " & d
    sortie = True

    Else
End If

   Next
End Sub

Bonjour,

Finalement j´ai trouvé un moyen, mais c´est tiré par les cheveux.

J´ai ajouté une condition qui vérifie l´état de sortie

If sortie = True Then Exit Sub

Merci à tous pour votre aide

Cordialement

ce qui donne:

Dim sortie As Boolean
Sub ArborescenceRepertoire()
  Racine = "C:\00_box"                    ' Répertoire courant
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set DossierRacine = fs.GetFolder(Racine)
  LitDossier DossierRacine, 1
End Sub

Sub LitDossier(ByRef Dossier, ByVal Niveau)

   For Each d In Dossier.SubFolders
   LitDossier d, Niveau + 1
    If d Like "*ici_01*" Then
        MsgBox "trouvé " & d
        sortie = True

    Else
        sortie = False

End If
If sortie = True Then Exit Sub

   Next
End Sub

Bonjour

La solution de Thev marche mais il ne sort pas instantanément de la boucle (remonte jusqu'au niveau 1 avant de sortir).

Le tiens ne fonctionne pas pour moi en raison du else

Bonjour,

Effectivement, j' ai constaté cela, ce qui me pose problème ayant 7000 dossiers à tester...

L' ideal serait de n'avoir qu'une procédure. j' ai posté cette question sur https://forum.excel-pratique.com/viewtopic.php?f=2&t=109428

Merci pour votre recherche

Cordialement