1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
| Dim fso As New FileSystemObject
Dim fld As Folder
Private Sub CommandButton1_Click()
Dim nDirs As Long, nFiles As Long, lSize As Currency
Dim repdep As String, chfich As String, r As String
Dim CheminComplet As String
Dim nbrepertoire
Dim nbr As Integer
CheminComplet = ActiveWorkbook.Path
nbrepertoire = Split(ActiveWorkbook.Path, "\")
r = ""
For nbr = 0 To 3 'repertoire de depart a changer en cas de besoin
r = r & nbrepertoire(nbr) & "\"
Next nbr
repdep = InputBox("choisir le dossier de depart", _
"FileSystemObjects example", r)
chfich = InputBox("type de fichier a chercher", _
"FileSystemObjects example", "*.doc")
Label1.Caption = "Résultat " & vbCrLf & UCase(repdep) & "..."
lSize = FindFile(repdep, chfich, nDirs, nFiles)
MsgBox str(nFiles) & " fichiers trouvés dans" & str(nDirs) & _
" directions", vbInformation
MsgBox "Soit = " & lSize & " bytes"
End Sub
Private Function FindFile(ByVal sFol As String, sFile As String, _
nDirs As Long, nFiles As Long) As Currency
Dim tFld As Folder, tFil As File, FileName As String
On Error GoTo Catch
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
List1.AddItem fso.BuildPath(fld.Path, FileName) ' Load ListBox
FileName = Dir() ' Get next file
DoEvents
Wend
Label1 = "Searching " & vbCrLf & fld.Path & "..."
nDirs = nDirs + 1
If fld.SubFolders.Count > 0 Then
For Each tFld In fld.SubFolders
DoEvents
FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles)
Next
End If
Exit Function
Catch: FileName = ""
Resume Next
End Function |
