Il nous arrive d'avoir besoin d'obtenir la liste des sous-dossiers d'un répertoire parent avec en plus un critère de recherche sur le nom comme - commence par
- se termine par
- contient
Il existe plusieurs méthodes pour le faire et entre autres la fonction Dir. J'ai écrit une fonction générique basée sur cette fonction et qui renvoie une liste sous forme de tableau.
C'est cette procédure que je publie et commente dans ce billet.
Code de la procédure
| Code VBA : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | Function GetFolderList(ByVal LookupFolder As String, Optional Criteria As String) ' Renvoie une liste des sous-dossier présents dans le répertoire défini pas l'argument LookupFolder ' Philippe Tulliez (http://www.magicoffice.be) ' Arguments ' LookupFolder (String) Nom du répertoire complet à parcourir ' [Criteria] (String) Chaîne de caractères ' Caractères génériques (*, ?) autorisés Dim f As String, c As Integer, t As Variant Dim n As String n = LookupFolder & Criteria f = Dir(n, vbDirectory) Do While Len(f) If f <> "." And f <> ".." And ((GetAttr(f) And vbDirectory) = vbDirectory) Then If c Then ReDim Preserve t(c) Else ReDim t(c) t(c) = f: c = c + 1: f = Dir Else f = Dir End If Loop GetFolderList = t End Function |
Exemple
Voici l'exemple d'une procédure qui invoque la fonction générique GetFolderList et renvoie la liste des sous-répertoires commençant par la lettre e présents dans le répertoire courant du classeur actif (ThisWorkbook).
Pour lister la liste complète des sous-répertoires, il suffit de ne conserver qu'une chaine vide "" de la constante c
| Code VBA : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | Sub TestGetFolderList() Const c As String = "e*" ' Critère de recherche Dim f As String ' Répertoire courant Dim t As Variant ' Table des sous-répertoires Dim m As String f = ThisWorkbook.Path & "\" t = GetFolderList(LookupFolder:=f, Filter:=c) m = "Répertoire courant :" & vbCrLf & " " & f & vbCrLf & " " & IIf(Len(c), " avec comme critère " & c, "") & vbCrLf If IsArray(t) Then m = m & Join(t, vbCrLf) Else m = m & "Pas trouvé" End If MsgBox m, Title:="Liste des sous-répertoires" End Sub |
Plongez plus profondément dans la fonction Dir avec ces autres billets