Boucle sur des sous-dossiers

Le 14/10/2018 à 16:21

Bonjour tout le monde !

Je me remet un peu au code, et je bute sur un truc tout bête.

J'ai l'intension de lister les fichiers dans différents dossiers et leurs sous-dossiers, mais je peine à faire une boucle pour "creuser" dans ces sous-dossiers. Résultat : quand j'ai des fichiers dans un "sous-sous(-sous...)-dossier, il n'est pas listé.

Voilà mon code. J'ai une feuille "Index" qui liste les dossiers à scanner avec la feuille sur laquelle je veux avoir cette liste.

Option Explicit
Sub Listing()
    Dim i%, j%, derligne%, feuille$, repertoire$, col%, k%
    Dim repFSO As Object, objFSO As Object, objFile As Object, sousrep As Object

    derligne = ThisWorkbook.Sheets("Index").Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To derligne 'On parcourt la liste des dossiers à scanner
        feuille = ThisWorkbook.Sheets("Index").Range("A" & i).Value
        derligne = ThisWorkbook.Sheets(feuille).Range("A" & Rows.Count).End(xlUp).Row
        ThisWorkbook.Sheets(feuille).Range("A2:C" & derligne + 1).Delete 'Deletion des infos dans la feuille traitée
        ThisWorkbook.Sheets(feuille).Range("A2:C" & derligne + 1).Interior.ColorIndex = xlColorIndexNone 'Effacement des couleurs présentes dans la feuille traitée
        repertoire = ThisWorkbook.Sheets("Index").Range("B" & i).Value 'Acquisition de l'adresse du répertoire à scanner
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set repFSO = objFSO.GetFolder(repertoire)

        With ThisWorkbook.Sheets(feuille)
             j = 1
                For Each objFile In repFSO.Files 'Pour chaque fichier dans le répertoire
                If objFile.Size > 1000000 Then 'Si taille > 1 Mo
                    .Cells(j + 1, 1) = objFile.Name 'Ajout du nom du fichier dans la colonne A
                    .Hyperlinks.Add Anchor:=.Cells(j + 1, 1), Address:=objFile.Path 'Ajout lien hypertexte
                    .Cells(j + 1, 2) = Round(objFile.Size / 1048576, 0) & " Mo" 'Taille en Mo du fichier dans la colonne B
                    j = j + 1 'On descend d'une ligne
                End If
            Next objFile
            col = 19 'Index couleur
            k = j + 1
            For Each sousrep In repFSO.subfolders
                For Each objFile In sousrep.Files
                    If objFile.Size > 1000000 Then
                    .Cells(j + 1, 1) = objFile.Name
                    .Hyperlinks.Add Anchor:=.Cells(j + 1, 1), Address:=objFile.Path
                    .Cells(j + 1, 2) = Round(objFile.Size / 1048576, 0) & " Mo"
                    j = j + 1
                End If
                Next objFile
                If j > k Then
                    .Range(.Cells(k, 1), .Cells(j, 3)).Interior.ColorIndex = col 'Couleur pour chaque sous-dossier
                    col = col + 1 'Passage à la oculeur suivante
                    If col > 20 Then col = 19 'Alternance entre les deux couleurs (Index 19 et 20) pour les sous-dossiers consécutifs
                    k = j + 1
                End If
            Next sousrep
            .Cells.EntireColumn.AutoFit 'Mise à la taille des colonnes
        End With
    Next i
End Sub

Je ne suis pas à l'aise dans la manipulation de fichiers et dossiers via VBA, donc votre aide sera la bienvenue

Le 14/10/2018 à 17:23

bonjour

le mieux est d'utiliser une fonction récursive ... voici un exemple que je fais dans un vbs...et j'ecris dans un fichier csv de sortie mais la structure est la même

le but étant de donné le dossier de départ au code et ensuite de l'appeler récursivement

fred

'Déclaration des constantes pour la lecture et l’écriture dans les fichiers
Const ForReading = 1
Const ForWritting = 2
Const ForAppending = 8

CheminScriptActuel = "c:\test"
CheminFichierResultat = CheminScriptActuel & "\" & "listing.csv"
'wscript.echo CheminFichierResultat
'Création des objets
Set objFSO = CreateObject("Scripting.FileSystemObject")
'On fait un objet qui représente le répertoire à explorer
Set objFolder = objFSO.GetFolder(CheminScriptActuel)
Set objTextFile = objFSO.OpenTextFile(CheminFichierResultat, ForWritting, True)

ListDirectory objFolder 
objTextFile.close

Sub ListDirectory(objFolder)

  objTextFile.WriteLine objFolder.path & "\"

  For Each objFile In  objFolder.Files
  objTextFile.WriteLine ";" & (objFile.Name)
  Next
  For Each objSubFolder In objFolder.SubFolders
    'objTextFile.WriteLine "sous-dossier : " & (objSubFolder.Name)
    ListDirectory(objSubFolder )
  Next
End Sub
Le 14/10/2018 à 17:29

Bonjour,

bonjour fred

une autre proposition basée sur le même principe

Sub Listing()
    Dim i%, j%, derligne%, feuille$, repertoire$, col%, k%
    Dim repFSO As Object, objfso As Object, objFile As Object, sousrep As Object

    derligne = ThisWorkbook.Sheets("Index").Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To derligne 'On parcourt la liste des dossiers à scanner
        feuille = ThisWorkbook.Sheets("Index").Range("A" & i).Value
        derligne = ThisWorkbook.Sheets(feuille).Range("A" & Rows.Count).End(xlUp).Row
        ThisWorkbook.Sheets(feuille).Range("A2:C" & derligne + 1).Delete 'Deletion des infos dans la feuille traitée
        ThisWorkbook.Sheets(feuille).Range("A2:C" & derligne + 1).Interior.ColorIndex = xlColorIndexNone 'Effacement des couleurs présentes dans la feuille traitée
        repertoire = ThisWorkbook.Sheets("Index").Range("B" & i).Value 'Acquisition de l'adresse du répertoire à scanner
        Set objfso = CreateObject("Scripting.FileSystemObject")
        scansousrept objfso, feuille, repertoire
    Next i
End Sub

Sub scansousrept(objfso, feuille, repertoire, Optional col = 1)
        Set repFSO = objfso.GetFolder(repertoire)
        col = col + 1
        For Each sousrep In repFSO.subfolders
        scansousrept objfso, feuille, sousrep, col
        Next
        With ThisWorkbook.Sheets(feuille)
             j = 1
                For Each objFile In repFSO.Files 'Pour chaque fichier dans le répertoire
                If objFile.Size > 1000000 Then 'Si taille > 1 Mo
                    .Cells(j + 1, 1) = objFile.Name 'Ajout du nom du fichier dans la colonne A
                    .Hyperlinks.Add Anchor:=.Cells(j + 1, 1), Address:=objFile.Path 'Ajout lien hypertexte
                    .Cells(j + 1, 2) = Round(objFile.Size / 1048576, 0) & " Mo" 'Taille en Mo du fichier dans la colonne B
                    j = j + 1 'On descend d'une ligne
                End If
            Next objFile
            .Cells.EntireColumn.AutoFit 'Mise à la taille des colonnes
        End With
End Sub
Rechercher des sujets similaires à "boucle dossiers"