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 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
|
Dim J As Integer
Dim Racine As Boolean
Sub test()
J = 0
Racine = True
ActiveSheet.UsedRange.Rows.Delete
RecupDossiers "E:\" 'adapte le chemin
End Sub
Private Sub RecupDossiers(Dossier As String)
Dim FSO As Object
Dim Dos As Object
Dim Fichier As Object
Dim I As Integer
Static DossierRacine As String
'supprime le "\" de fin
If Right(Dossier, 1) = "\" Then Dossier = Left(Dossier, Len(Dossier) - 1)
If DossierRacine = "" Then DossierRacine = Dossier
'crée l'objet FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
'si le dossier n'existe pas
If FSO.FolderExists(Dossier) = False Then
MsgBox "Le dossier portant ce nom n'existe pas !"
Exit Sub
End If
'si c'est le dossier racine
If Racine = True Then
J = 1
Cells(J, 1) = Right(Dossier, Len(Dossier) - InStrRev(Dossier, "\"))
Cells(J, 1).Font.Bold = True
Cells(J, 1).Interior.ColorIndex = 27
'récupère les fichiers contenus dans le dossier racine
For Each Fichier In FSO.GetFolder(Dossier).Files
J = J + 1
Cells(J, 1) = Fichier.Name
Next Fichier
Racine = False
End If
'si c'est le lecteur, il n'y a pas de "\" donc, I doit être à 1 pour colonne A
If InStr(Dossier, "\") = 0 Then I = 1 Else I = 0
'boucle sur les dossiers
For Each Dos In FSO.GetFolder(Dossier).SubFolders
'défini I en recherchant les "\" afin de créer un décalage pour la hiérarchie
I = UBound(Split(Replace(Dos, "\", ";"), ";")) - UBound(Split(Replace(DossierRacine, "\", ";"), ";")) + 1
J = J + 1
'récupère le nom du dossier et mets le nom en gras
Cells(J, I) = Dos.Name
Cells(J, I).Font.Bold = True
Cells(J, I).Interior.ColorIndex = 27
With Cells(J, I - 1).Borders(8)
.LineStyle = xlContinuous
.ColorIndex = 27
.Weight = 4
End With
'évite l'erreur des fichiers interdits
On Error Resume Next
'récupère les fichiers contenus dans le dossier en cours
For Each Fichier In Dos.Files
J = J + 1
Cells(J, I) = Fichier.Name
Next Fichier
'rappel de la proc pour chercher les dossiers enfants
RecupDossiers Dossier & "\" & Dos.Name
Next Dos
End Sub |
Partager