Comme établir la liste des fichiers contenus dans un répertoire avec un lien hypertexte pointant sur chacun ?

La macro Repertorier appelle la fonction Lister en lui passant en paramètres les choix de l'utilisateur sur
- le dossier à analyser
- L'inclusion ou non des sous dossiers,
- Le N° de la ligne ou commencer à incrire les données
- Le filtrage éventuel sur un type de fichier.

sub Repertorier()  'Une méthode basique sans API pour lister les répertoires et  'sous-répertoires. Michel Pierron, MPFE 2002. Adaptation Flo Cabon sur une idée de "mrik"  
'* nRow = Ligne de départ 
 '* FolderName = Chemin du répertoire à lister 
 '* Suffix = Filtre optionnel des types de fichiers  
'* subDir = True pour étendre la liste aux sous-répertoires

 Dim LeMessage As String, LeRepertoire As String, Lextension As String
 Dim Profondeur As VbMsgBoxResult
 Dim nRow As Long
 
 LeMessage = "Choisissez le dossier à analyser"
 LeRepertoire = GetDirectory(LeMessage)
 Lextension = InputBox("indiquez éventuellement une extension de fichier pour filtrer les fichiers", "Type de fichier", "*.*")
 Profondeur = MsgBox("Voulez vous analyser aussi les sous-répertoires ?", vbYesNo, "Profondeur d'analyse")
 nRow = InputBox("indiquez le N° de la première ligne pour le tableau de sortie", "Sortie des résultats", "1")
 If Profondeur = vbYes Then
 truc = Lister(nRow, LeRepertoire, Lextension, True)
 Else
 truc = Lister(nRow, LeRepertoire, Lextension, False)
 End If
 end sub

Function Lister(nRow&, FolderName$, Optional Suffix$ = "*.*", Optional 
subDir As Boolean = True)  Dim i As Long, x As Long, File As String, Folder As String, nbFolders() As String      Cells(nRow, 1) = FolderName  Cells(nRow, 1).Font.Bold = True  If Not Right(FolderName, 1) = "" Then FolderName = FolderName & ""  File = Dir(FolderName & Suffix)    Do While Len(File) > 0  With ActiveSheet  .Hyperlinks.Add Anchor:=.Cells(nRow, 2), _  Address:=FolderName & File, _  TextToDisplay:=File  End With  nRow = nRow + 1  File = Dir  Loop    If Not 
subDir Then Exit Function
 x = 0
 Folder = Dir(FolderName, vbDirectory)
 
 Do While Folder > ""
 If Folder <> "." And Folder <> ".." Then
 If (GetAttr(FolderName & Folder) And vbDirectory) = vbDirectory Then x = x + 1
 End If
 Folder = Dir
 Loop
 
 ReDim nbFolders(x + 1)
 i = 1
 nbFolders(i) = Dir(FolderName, vbDirectory)
 Do While nbFolders(i) > ""
 If nbFolders(i) <> "." And nbFolders(i) <> ".." Then
 If (GetAttr(FolderName & nbFolders(i)) And vbDirectory) = vbDirectory Then i = i + 1
 End If
 nbFolders(i) = Dir
 Loop
 For i = 1 To UBound(nbFolders()) - 1
 Call Lister(nRow, FolderName & nbFolders(i), Suffix)
 Next
 End Function
Astuce illustrée par ce classeur
mpfc-repertoires