Sub ScanClasseurs()
Dim Dossier As Object, Fichier As Object
Dim Chemin As String, CeFichier As String, ExtFichier As String
Dim TabDossiers As Variant
Dim L As Long, D As Long, s As Variant
Chemin = CheminUser
If Chemin = "" Then Exit Sub
Application.ScreenUpdating = False
'ThisWorkbook.Sheets("Test").Range("A2:B65536").Delete Shift:=xlUp
CeFichier = ThisWorkbook.Name
ExtFichier = UCase(Trim(ThisWorkbook.Sheets("Test").Range("Extension").Text))
L = 1
'Création du tableau des sous-dossiers existants
TabDossiers = lstDossiers(Chemin, True)
For D = 1 To UBound(TabDossiers)
'Chemin du dossier (ou sous-dossier) à analyser
Chemin = TabDossiers(D)
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
'Analyse du dossier (ou sous-dossier)
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In Dossier.Files
If Fichier.Name <> CeFichier Then
If ExtFichier = "" Or UCase(Right(Fichier.Name, 3)) = ExtFichier Then
'Liste les fichiers
'MAJ feuille résultats
With ThisWorkbook.Sheets("Test")
L = .Range("A" & Rows.Count).End(xlUp).Row + 1
'L = DerLig + 1
s = Split(Left(Chemin, Len(Chemin) - 1), "\")
.Cells(L, 1).Value = s(UBound(s))
.Hyperlinks.Add Anchor:=.Cells(L, 2), Address:=Chemin & Fichier.Name, _
TextToDisplay:=Fichier.Name
.Cells(L, 3).Value = Fichier.DateCreated
'L = L + 1
End With
End If
End If
Next
Next D
Set Dossier = Nothing
'Rétablit l'alerte de lien éventuelle dans les options Excel
Application.ScreenUpdating = True
MsgBox L - 1 & " fichiers trouvés !"
End Sub
