Option Explicit
 
' Dans VBA Outils | Références : Cocher Microsoft Scripting Runtime
 
Const DossierFichiers As String = "C:\Utiles"
 
Sub Liste()
    ShImport.Cells.Clear
    ListeFichiersDansDossier DossierFichiers, True
End Sub
 
Private Sub ListeFichiersDansDossier(ByVal NomDossierSource As String, ByVal InclureSousDossiers As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder, SousDossier As Scripting.Folder
Dim Fichier As Scripting.File
Dim r As Long
 
    Set FSO = New Scripting.FileSystemObject
    Set DossierSource = FSO.GetFolder(NomDossierSource)
 
    r = Range("A65536" ).End(xlUp).Row + 1
 
    For Each Fichier In DossierSource.Files
        With ShImport
            .Cells(r, 1).Formula = Fichier.Name
            .Cells(r, 2).Formula = Fichier.ParentFolder
        End With
        r = r + 1
    Next Fichier
     
    If InclureSousDossiers Then
        For Each SousDossier In DossierSource.SubFolders
            ListeFichiersDansDossier SousDossier.Path, True
        Next SousDossier
        Set SousDossier = Nothing
    End If
     
    Set Fichier = Nothing
    Set DossierSource = Nothing
    Set FSO = Nothing
End Sub