Philippe Tulliez

VBA/Excel - Fonction qui renvoie la liste des fichiers d'un répertoire en fonction d'un critère

Noter ce billet

par

, 16/04/2022 à 13h45 (3317 Affichages)

Nom : GetFileList.png
Affichages : 1867
Taille : 17,3 Ko

Introduction
Nous sommes régulièrement amené à devoir obtenir la liste de fichiers présents dans un répertoire afin par exemple de les charger, les copier, les insérer en ajoutant éventuellement un critère sur le nom qui

commence par
se termine par
contient

Il existe plusieurs méthodes pour le faire et entre autres la fonction Dir. J'ai écrit il y a quelques années une fonction générique qui l'utilise 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
Function GetFileList(ByVal LookUpFullName As String) As Variant
  ' Renvoie une liste des fichiers présents dans le répertoire défini pas l'argument LookUpFullName
  '     Les caractères génériques (*, ?) 
  ' Philippe Tulliez (http://www.magicoffice.be)
  ' Arguments
  '   LookUpFullName (String) Répertoire complet + nom du fichier partiel ou pas + éventuellement extension
  '
  Dim f As String, c As Integer, t As Variant
  f = Dir(LookUpFullName)
  Do While Len(f)
    If c Then ReDim Preserve t(c) Else ReDim t(c)
    t(c) = f: c = c + 1: f = Dir
  Loop
  GetFileList = t
End Function

Exemple
Voici l'exemple d'une procédure qui invoque la fonction générique GetFileList et renvoie la liste des fichiers suffixés jpg présents dans le sous-répertoire nommé Picture du classeur actif (ActiveWorkbook).
Cette liste est ensuite chargée dans le ListBox nommé lstItems2Select présent dans un UserForm

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
Sub TestGetFileList()
  Const SubFolder As String = "\Picture\"
  Const LookUpValue As String = "*.jp?"
  Dim FullName As String
  Dim Tbl As Variant, msg As String, e As Integer
  '
  FullName = ActiveWorkbook.Path & SubFolder & LookUpValue
  Tbl = GetFileList(FullName)
  If IsArray(Tbl) Then
     With UserForm1
     .lstItems2Select.List = Tbl
     .Caption = "Sélection des fichiers"
     .Show
     End With
   Else
     msg = "Pas trouvé de feuille correspondant au critère dans le sous-répertoire " & SubFolder
     MsgBox msg, Title:="Sélection des feuilles " & LookUpValue
  End If
End Sub