Repertoires .... encore

[Eric]

Bonjour,

Thierry m'a donné le code suivant il y a une semaine ... est-ce possible d'adapter celui-ci pour qu'il ne m'affiche UNIQEMENT les répertoires d'un niveau voulu.

Par exemple, le premir niveau contient les dossiers 100,200,300.... le dossier 100 contient le dossier de second niveau : 100, 110, 120, 130...
et le dossier 100 contient les dossiers 101,102,103.... et le dossier 110 contient les dossiers 111,112,113....

J'aimerais qu'il m'affiche seulement les dossiers du second niveau: 100,110 ... 200, 210 ....

Est-ce possible? Suis je clair?


Merci



/*****************

Sub test()
TousLesDossiers "c:\100", 0
End Sub

Sub TousLesDossiers(LeDossier$, Idx As Long)
Dim fso As Object, Dossier As Object
Dim sousRep As Object, Flder As Object

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

'examen du dossier courant
For Each Flder In Dossier.SubFolders
Idx = Idx + 1
Cells(Idx, 1).Value = Flder.Path
Next

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

End Sub 'fs

/***************************************

 

[@+Thierry]

Bonsoir Eric,


Oui c'est Possible... Il suffisait de simplifier le code en supprimant la partie pour obtenir les sous-répertoire et en changeant la valeur de Fldr en tant que .Name et non plus en tant que .Path


C'était pas bien compliqué....
En prime j'ai déclaré les variable en option explicit et t'ai fait une textbox de saisie du répertoire racine du niveau que tu veux veux lister. (J'espère que c'est çà que tu veux ??)

/*********************************************************

Option Explicit
Sub test()
Dim Repertoire As String
Repertoire = InputBox("Nom du répertoire (niveau de départ)", "NOM DU REPERTOIRE", "Mes Documents")
TousLesDossiers "c:\" & Repertoire, 0
End Sub

Sub TousLesDossiers(LeDossier$, Idx As Long)
Dim fso As Object, Dossier As Object, Flder As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(LeDossier)
For Each Flder In Dossier.SubFolders
Idx = Idx + 1
Cells(Idx, 1).Value = Flder.Name
Next
Set fso = Nothing
End Sub 'fs <--- (Frédéric Sigonneau)

/*********************************************************

C'est ok ?
Bonne Nuit
@+Thierry

 

[Eric]

hehe Non Thierry ce n'est pas ce que je voulais faire, mais ce que tu m'as écrit m'a permis de mieux comprendre le code et de trouver la solution moi meme!

Merci 🙂


Eric