par , 16/04/2022 à 13h45 (3590 Affichages)
![Nom : GetFileList.png
Affichages : 1995
Taille : 17,3 Ko](https://www.developpez.net/forums/attachment.php?attachmentid=617490&d=1650103395)
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
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
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 |
Découvrez plus sur la fonction Dir avec ces billets