Option Explicit
Sub Test()
Dim Chemin As String, Dossier As Object, SousDossier As Object, Fichier As Object
Dim nDirs As Long, nFiles As Long, lSize As Currency
Dim sDir As String, sExt As String
sDir = "C:\Mes documents\Informatique\Excel\"
If sDir = "" Then Exit Sub
sExt = InputBox("Quelle extension ?")
If sExt = "" Then sExt = "*.*"
lSize = FindFile(sDir, sExt, nDirs, nFiles, 1)
MsgBox Str(nFiles) & " fichiers trouvés dans " & Str(nDirs) & _
" répertoires pour un total de " & lSize & " bytes"
End Sub
Private Function FindFile(ByVal sFol As String, sFile As String, _
nDirs As Long, nFiles As Long, x As Long) As Currency
Dim Fso, Fld, tFld, tFil, FileName As String, fs As Object
Dim Ext As String
On Error GoTo Suite
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fld = Fso.GetFolder(sFol)
FileName = Dir(Fso.BuildPath(Fld.Path, sFile), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
While Len(FileName) <> 0
FindFile = FindFile + FileLen(Fso.BuildPath(Fld.Path, FileName))
nFiles = nFiles + 1
Set fs = Fso.GetFile(Fso.BuildPath(Fld.Path, FileName))
Ext = Fso.GetExtensionName(Fso.BuildPath(Fld.Path, FileName))
Cells(x, 1) = Fld.Path
Cells(x, 2) = fs.Name
Cells(x, 3) = fs.Type
Cells(x, 4) = Ext
Cells(x, 5) = fs.Size
x = x + 1
FileName = Dir()
DoEvents
Wend
nDirs = nDirs + 1
If Fld.SubFolders.Count > 0 Then
For Each tFld In Fld.SubFolders
DoEvents
FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles, x)
Next
End If
Exit Function
Suite:
FileName = ""
Resume Next
End Function