VBA - Comment lister les sous-dossiers d'un répertoire parent avec critère à l'aide de la fonction Dir,

Un billet blog de Philippe Tulliez

Introduction
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
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
' (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
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

• Fonction qui renvoie la liste des fichiers d'un répertoire en fonction d'un critère
  
• Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier