Lister les sous-dossiers d’un dossier
Dans un article précédent, il était question de compter le nombre de sous-dossiers d’un dossier de départ quelconque. Cette fois, on va essayer de lister les sous-dossiers d’un dossier dans un tableau, plutôt que de récupérer seulement leur nombre.
Le code
On pourrait faire plus simple que de renvoyer les sous-dossiers dans un tableau VBA, mais l’intérêt est de pouvoir réutiliser cette liste de dossiers à d’autres endroits de votre application. Par conséquent, la fonction ci-dessous renvoie un tableau qui contient…
- Soit une liste des chemins complets des sous-dossiers trouvés (du type :
C:\...\SousDossier) - Soit un tableau vide
Pour que ça fonctionne :
- Recopiez la fonction
CompterSousDossiers()vue dans l’article Compter le nombre de sous-dossiers d’un dossier. Le code de cet article en a besoin. - Recopiez le code qui suit dans un module standard de votre base.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 |
' --- ' LISTE DE SOUS-DOSSIERS D'UN DOSSIER DE DEPART ' --- ' Function ListerSousDossiers(ByVal strDossier As String) As Variant ' Variables Dim intSousDossiers As Integer Dim astrSousDossiers() As String Dim strSousDossier As String Dim intI As Integer ' Compter les sous-dossiers strDossier = AddBackslash(strDossier) intSousDossiers = CompterSousDossiers(strDossier) ' Si aucun sous-dossier, on renvoie un tableau vide If (intSousDossiers = 0) Then ListerSousDossiers = Array() Exit Function End If ' Lire les chemins des sous-dossiers ReDim astrSousDossiers(1 To intSousDossiers) As String strSousDossier = Dir(strDossier, vbDirectory) intI = 1 While strSousDossier <> "" If (strSousDossier <> ".") And (strSousDossier <> "..") Then If (GetAttr(strDossier & strSousDossier) And vbDirectory) <> 0 Then astrSousDossiers(intI) = strDossier & strSousDossier intI = intI + 1 End If End If strSousDossier = Dir Wend ' Résultat ListerSousDossiers = astrSousDossiers End Function |
Tester le code
Tout seul, ce code n’est pas encore très utile. Mais vous pouvez déjà le tester dans la fenêtre Exécution, en y tapant des lignes comme celles-ci (Entrée en fin de chaque ligne pour valider) :
|
1 2 |
? ListerSousDossiers("C:\Users\Hervé\Documents")(1) ? UBound(ListerSousDossiers("C:\Users\Hervé\Documents")) |
- La première ligne affiche le nom du premier dossier trouvé (il faut qu’il en existe au moins un). Les dossiers sont numérotés de 1 à n.
- La deuxième ligne affiche le nombre de dossiers (à savoir : l’indice supérieur du tableau).
Pour un test plus long, recopiez le code qui suit dans votre module (en adaptant le dossier bien sûr), et exécutez-le :
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
Sub TestListeSousDossiers() Dim strDossier As String Dim varSousDossiers As Variant Dim intSousDossiers As Integer Dim intI As Integer strDossier = "C:\Users\Hervé\Documents" varSousDossiers = ListerSousDossiers(strDossier) intSousDossiers = UBound(varSousDossiers) If intSousDossiers <= 0 Then Debug.Print "Aucun sous-dossier" Else Debug.Print "Sous-dossiers : " & intSousDossiers For intI = 1 To intSousDossiers Debug.Print varSousDossiers(intI) Next End If End Sub |
