Philippe Tulliez

[Actualit�] VBA Comment lister les sous-dossiers d'un r�pertoire parent avec crit�re � l'aide de la fonction Dir

Noter ce billet

par

, 30/04/2023 � 07h59 (6555 Affichages)

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

Code VBA :

S�lectionner tout - Visualiser dans une fen�tre � part

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 - Visualiser dans une fen�tre � part

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