Lister le nombre de fichiers dans un dossier et ses sous dossiers

Bonjour le Forum,

Je viens encore une fois solliciter votre aide, car je n'ai rien trouvé sur divers forums qui puisse convenir à mon besoin, ni réussi à créer quelque chose qui tienne la route.

Je souhaiterais une macro qui me liste sur la feuille courante, par exemple en colonne "A" le nom des dossiers et sous dossiers d'un répertoire donné et en colonne "B" le nombre de fichiers contenus dans chaque dossier.

Je renseignerai le nom du répertoire source directement dans une variable de la macro.

Merci par avance de m'avoir lu et aidé, ainsi que pour le temps que vous y avez consacré.

Bien cordialement

bonjour,

une proposition

Sub aargh()
    Dim fs As Object, wsh As Object

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Set fs = CreateObject("scripting.filesystemobject")
    Set wsh = ActiveSheet
    chemin = "d:\downloads\" '<----- à adapter répertoire de départ
    i = 5
    traiterepertoire wsh, fs, chemin, i
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

Sub traiterepertoire(wsh_result As Object, fs As Object, chemin, ByRef i)
    Set rep = fs.getfolder(chemin)
    i = i + 1
    Cells(i, 1) = chemin
    Cells(i, 2) = rep.subfolders.Count 'nombre de sous-répertoires dans ce répertoire (sous-répertoires dans sous-répertoires non  compris)
    Cells(i, 3) = rep.Files.Count 'nombre de fichiers dans ce répertoire (fichiers dans sous-répertoires non compris)
    For Each sousrep In rep.subfolders
        traiterepertoire wsh_result, fs, sousrep, i
    Next
End Sub

Merci h2so4 pour la réponse,

Mais à la ligne

    Set fs = CreateObject("scripting.filesystemobject")

j'ai le message "Erreur d'exécution 429" Un composant ActiveX ne peut pas créer d'objet.

Petite précision, je suis sous MAC.

D'autre part, j'ai besoin de lister le nom et le nombre de fichiers de chaque dossier, à 2 niveaux du chemin déclaré. Le chemin que je déclare contient plus d'une centaine de dossiers. Chacun de ces dossiers contient un ou plusieurs sous-répertoires, mais pas de fichier. J'ai besoin du nom et du nombre de fichiers de ces sous-répertoires.

(j'espère que c'est compréhensible)

Bonjour,

je n'avais pas capté que c'était sur Mac. La solution proposée ne fonctionne pas sur Mac. Je n'ai pas d'autre solution à proposer.

@ h2so4

Pas de souci, merci tout de même

Plus besoin de se creuser la tête, j'ai résolu mon problème d'une autre manière

Merci à la communauté de vous être penché sur la question.

Bonjour le Forum,

Il y a deux jours je cherchais à compter le nombre de fichiers dans un répertoire donné, j'ai réussi à contourner le problème. Depuis je cherche à lister ces mêmes fichiers sur une feuille Excel, sans rien trouver qui puisse me convenir, avec ou sans modifications ...

Je cherche simplement à lister l'ensemble des fichiers et leur arborescence à partir d'un dossier.

Par exemple :

J'indique le chemin du dossier à scruter dans la macro, puis celle-ci renseigne la feuille active comme ceci.

Colonne "A" le nom du fichier,

Colonne "B" l'arborescence.

Tout ceci SANS Set Fso = CreateObject("Scripting.FileSystemObject"), car je suis sous MAC.

D'avance Merci de me lire et pour le temps que vous consacrez à ce problème

bonjour,

une autre proposition, (non testée), mettre le premier repertoire en A1 puis lancer la macro

Sub listefichiers()
    ptrrep = 1
    encours = 1
    Do While Cells(encours, 1) <> ""
        repertoire = Cells(encours, 1)
        On Error Resume Next
        nd = Dir(repertoire & "\*", vbDirectory)
        On Error GoTo 0
        Do While nd <> ""
        If nd <> "." And nd <> ".." Then
            ptrrep = ptrrep + 1
            Cells(ptrrep, 1) = repertoire & "\" & nd
            End If
            nd = Dir()
            DoEvents
        Loop
        encours = encours + 1
        DoEvents
    Loop
    Range("A1").Resize(ptrrep, 1).Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlNo
    MsgBox "terminé"
End Sub

Si cela fonctionne, il suffit d'exploiter les données de la feuille pour les présenter comme tu les souhaites.

Bonsoir,

Ces lignes ne fonctionneront pas sous MAC

1. Remplacez

nd = Dir(repertoire & "\*", vbDirectory)

par

nd = Dir(repertoire & Application.PathSeparator & "*", vbDirectory)

2. Remplacez par

 Cells(ptrrep, 1) = repertoire & "\" & nd

à remplacer par

 Cells(ptrrep, 1) = repertoire & Application.PathSeparator & nd

Reste peut-être à déclarer les variables..

Cordialement

Merci h2so4 et Dan

Avec les modifications proposées par Dan j'ai tous les fichiers et répertoires listés en colonne "A".

Serait-il possible de scinder le nom du répertoire du nom du fichier ? Sinon tant pis, je ferai avec.

Ou, "Plan B" ne lister que le nom du fichier.

Merci beaucoup pour votre aide

re-

avec les adaptations proposées par Dan (non testé)

toujours valable , mettre le premier repertoire en A1 puis lancer la macro

Option Explicit

Sub listefichiers()
Dim aps$, ptrrep&, encours&, repertoire$, nd$, i&, f$

    aps = Application.PathSeparator
    ptrrep = 1
    encours = 1
    Do While encours <= ptrrep
        repertoire = Cells(encours, 1)
        If Right(repertoire, 2) <> "\." Then
            On Error Resume Next
            nd = Dir(repertoire & aps & "*", vbDirectory)
            On Error GoTo 0
            Do While nd <> ""
                If nd <> ".." Then
                    ptrrep = ptrrep + 1
                    Cells(ptrrep, 1) = repertoire & aps & nd
                End If
                nd = Dir()
                DoEvents
            Loop
        End If
        encours = encours + 1
        DoEvents
    Loop

    Range("A1").Resize(ptrrep, 2).Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlNo

    For i = ptrrep To 2 Step -1
        f = Cells(i, 1)
        If Right(f, 2) = aps & "." Then
            Cells(i, 1) = Cells(i - 1, 1)
            Rows(i).Delete
            i = i - 1
        Else
            Cells(i, 1) = ""
            Cells(i, 2) = Mid(f, InStrRev(f, aps) + 1)
        End If
    Next i
    Columns("A:B").AutoFit
    MsgBox "terminé"
End Sub

Bonsoir à tous

Ce domaine met bien connu surtout sur des serveurs contenant des millions de fichiers

Même depuis une station connecté filtrer la réponse de la commande dir /S permet de gagner énormément de temps mais ce n'est peut être pas le cas : tant mieux.

j'aimerai aussi savoir comment le faire sur un Mac où FileSystemObject n'existe pas pour répondre à une demande sur ce forum.

Merci h2so4 et tous les membres du Forum,

Ca marche, donc j'arriverai à me débrouiller avec.

Encore Merci