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
|