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
| 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
ListBox1.AddItem fso.BuildPath(fld.ShortPath, FileName) ' a adapter
'ou ListBox1.AddItem FileName
FileName = Dir() ' Get next file
DoEvents
Wend
Label1 = "Recherche " & vbCrLf & fld.Path & "..."
nDirs = nDirs + 1
Exit Function
Catch: FileName = ""
Resume Next
End Function
Private Sub CommandButton1_Click()
Dim nDirs As Long, nFiles As Long, lSize As Currency
Dim sDir As String, sSrchString As String
sDir = InputBox("Repertoire de départ", _
"Vous pouvez modifier", ThisWorkbook.Path)
sSrchString = InputBox(" ", _
"Recherche et Ajout" & ".xls")
Label1.Caption = "Recherche " & vbCrLf & UCase(sDir) & "..."
lSize = FindFile(sDir, sSrchString, nDirs, nFiles)
MsgBox Str(nFiles) & " Fichiers trouvés dans" & Str(nDirs) & _
" repertoire(s)", vbInformation
End Sub |
Partager