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
| 'Declaration
Dim stRepInital 'Nom du répertoire à parcourir
Dim oFSO, oFld, oSubFolder
'==============================================
'Fonction récursive de parcours d'un répertoire
'==============================================
'http://vb.developpez.com/telecharger/detail/id/797/Fonction-recursive-de-parcours-d-un-repertoire
Sub ParcoursRepT()
Call stRecInit
Call ParcoursRep(stRepInital)
End Sub
Sub stRecInit()
Set oFSO = CreateObject("Scripting.FileSystemObject")
stRepInital = ThisWorkbook.Path 'lance à partir du repertoire ou il y a le code
End Sub
Sub ParcoursRep(ByVal stRep As String)
MsgBox "Traite : " & stRep
If oFSO.FolderExists(stRep) Then
Set oFld = oFSO.GetFolder(stRep)
MsgBox "Size :" & oFld.Size
If oFld.SubFolders.Count > 0 Then 'Teste le nombre de sous-répertoire dans stRep
MsgBox "Name :" & oFld.Path & "oFld.Count :" & oFld.SubFolders.Count
For Each oSubFolder In oFld.SubFolders
ParcoursRep oSubFolder.Path 'appel récursif de la procédure
Next
Else
If oFld.Files.Count > 0 Then 'Teste le nombre de fichier dans le sous-répertoire
MsgBox "Non Vide fichiers : " & oFld.Files.Count
Else
MsgBox "===> A detruire ===> " & oFld.Name & "SubFolders.Count :" & oFld.SubFolders.Count
End If
End If
End If
End Sub |
Partager