Option Explicit
Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean
Dim NbFichiers As Long, NbDossiers As Long
Dim Dep As Currency, Fin As Currency, Freq As Currency
Private Sub Liste(ByVal sChemin As String, ByVal bSousDossier As Boolean)
Dim FSO As Object, Dossier As Object, SousDossier As Object, Fichier As String
Set FSO = CreateObject("Scripting.FileSystemObject" )
Set Dossier = FSO.GetFolder(sChemin)
Fichier = Dir$(sChemin & "\*.*" )
Do While Len(Fichier) > 0
NbFichiers = NbFichiers + 1
With Feuil1
.Cells(NbFichiers, 1) = sChemin
.Cells(NbFichiers, 2) = Fichier
End With
Fichier = Dir$()
Application.StatusBar = "Dossiers : " & NbDossiers & " Fichiers : " & NbFichiers
Loop
If bSousDossier Then
For Each Dossier In Dossier.SubFolders
NbDossiers = NbDossiers + 1
Liste Dossier.Path, True
Next Dossier
End If
Set Dossier = Nothing
Set FSO = Nothing
End Sub
Sub Tst()
Dim sChemin As String
sChemin = ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = sChemin & "\"
.Title = "Sélectionner un Dossier"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewDetails
.ButtonName = "Sélection Dossier"
.Show
If .SelectedItems.Count > 0 Then
Feuil1.Cells.Clear
Application.ScreenUpdating = False
Application.StatusBar = ""
DoEvents
QueryPerformanceCounter Dep
NbFichiers = 0: NbDossiers = 0
Liste .SelectedItems(1), True
Application.ScreenUpdating = True
QueryPerformanceCounter Fin: QueryPerformanceFrequency Freq
Application.StatusBar = "Dossiers : " & NbDossiers & " Fichiers : " & NbFichiers & " / " & Format(((Fin - Dep) / Freq), "0.00 s" )
End If
End With
End Sub |
