'==================================================================
'
' Dans VBA Outils | Références : Cocher Microsoft Scripting Runtime
'
'==================================================================
 
Option Explicit
 
Dim r As Long
Const DossierRacine As String = "C:\Transfert\Essais"
Const MasqueFichier As String = "Fichier*.txt"
 
Sub Lister()
    ShImport.Cells.Clear
    r = 1
    ListeFichiersDansDossier DossierRacine, 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
 
    Set FSO = New Scripting.FileSystemObject
    Set DossierSource = FSO.GetFolder(NomDossierSource)
     
    For Each Fichier In DossierSource.Files
        If UCase(Fichier.Name) Like UCase(MasqueFichier) Then
            With ShImport
                .Cells(r, 1) = Fichier.Name
                .Cells(r, 2) = Fichier.ParentFolder
            End With
            Application.StatusBar = "Lecture : " & r
            r = r + 1
        End If
    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