Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Comptage de dossiers et sous-dossiers

Comptage de dossiers et sous-dossiers

2 réponses
Avatar
Infogroup
Re-bonjour,

Dans un post du 23 janvier, Daniel.C m'avait donné une macro pour lister les
dossiers et sous-dossiers d'un réperoire.

Aujourd'hui, je voudrais pouvoir compter pour un répertoire donné D:\Copie
par ex. :

Le nombre de sous-répertoires de rang 1

Le nombre de sous-répertoires de rang 2

Le nombre de sous-répertoires de rang 3 etc...

Pour info, la macro était la suivante :
D'après une macro de JB :

Public Ligne As Long 'à mettre en tête du module

Sub ListeDossiers()
Ligne = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder("D:\Copie")
Lit_dossier dossier_racine
End Sub

Sub Lit_dossier(ByRef dossier)
Ligne = Ligne + 1
Cells(Ligne, 1) = dossier.Path
For Each d In dossier.SubFolders
Lit_dossier d
Next
End Sub

Merci par avance

Cdl

Infogroup
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Mishell
Bonjour.

Dim Ligne
Dim niveaux()

Sub ListeDossiers()
Ligne = 1

ReDim niveaux(0)

Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder("c:aa")
Lit_dossier dossier_racine

For i = 1 To UBound(niveaux)
Ligne = Ligne + 1
Cells(Ligne, 1) = "Niveau " & i
Cells(Ligne, 2) = niveaux(i)
Next

End Sub

Sub Lit_dossier(ByRef dossier)
Ligne = Ligne + 1
Cells(Ligne, 1) = dossier.Path
Call Repertoires_par_niveau(dossier.Path)

For Each d In dossier.SubFolders
Lit_dossier d
Next
End Sub

Sub Repertoires_par_niveau(chemin)

Dim nombre As Long

debut = 1
nombre = 0
While InStr(debut, chemin, "") > 0

nombre = nombre + 1
debut = InStr(debut, chemin, "") + 1
Wend

If UBound(niveaux) < nombre Then
ReDim Preserve niveaux(nombre)
End If
niveaux(nombre) = niveaux(nombre) + 1

End Sub

Mishell


"Infogroup" wrote in message
news:
Re-bonjour,

Dans un post du 23 janvier, Daniel.C m'avait donné une macro pour lister
les dossiers et sous-dossiers d'un réperoire.

Aujourd'hui, je voudrais pouvoir compter pour un répertoire donné D:Copie
par ex. :

Le nombre de sous-répertoires de rang 1

Le nombre de sous-répertoires de rang 2

Le nombre de sous-répertoires de rang 3 etc...

Pour info, la macro était la suivante :
D'après une macro de JB :

Public Ligne As Long 'à mettre en tête du module

Sub ListeDossiers()
Ligne = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder("D:Copie")
Lit_dossier dossier_racine
End Sub

Sub Lit_dossier(ByRef dossier)
Ligne = Ligne + 1
Cells(Ligne, 1) = dossier.Path
For Each d In dossier.SubFolders
Lit_dossier d
Next
End Sub

Merci par avance

Cdl

Infogroup


Avatar
Infogroup
Merci beaucoup Mishell, c'est impeccable

Cordialement

Infogroup






"Mishell" a écrit dans le message de
news:%23$
Bonjour.

Dim Ligne
Dim niveaux()

Sub ListeDossiers()
Ligne = 1

ReDim niveaux(0)

Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder("c:aa")
Lit_dossier dossier_racine

For i = 1 To UBound(niveaux)
Ligne = Ligne + 1
Cells(Ligne, 1) = "Niveau " & i
Cells(Ligne, 2) = niveaux(i)
Next

End Sub

Sub Lit_dossier(ByRef dossier)
Ligne = Ligne + 1
Cells(Ligne, 1) = dossier.Path
Call Repertoires_par_niveau(dossier.Path)

For Each d In dossier.SubFolders
Lit_dossier d
Next
End Sub

Sub Repertoires_par_niveau(chemin)

Dim nombre As Long

debut = 1
nombre = 0
While InStr(debut, chemin, "") > 0

nombre = nombre + 1
debut = InStr(debut, chemin, "") + 1
Wend

If UBound(niveaux) < nombre Then
ReDim Preserve niveaux(nombre)
End If
niveaux(nombre) = niveaux(nombre) + 1

End Sub

Mishell


"Infogroup" wrote in message
news:
Re-bonjour,

Dans un post du 23 janvier, Daniel.C m'avait donné une macro pour lister
les dossiers et sous-dossiers d'un réperoire.

Aujourd'hui, je voudrais pouvoir compter pour un répertoire donné
D:Copie par ex. :

Le nombre de sous-répertoires de rang 1

Le nombre de sous-répertoires de rang 2

Le nombre de sous-répertoires de rang 3 etc...

Pour info, la macro était la suivante :
D'après une macro de JB :

Public Ligne As Long 'à mettre en tête du module

Sub ListeDossiers()
Ligne = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder("D:Copie")
Lit_dossier dossier_racine
End Sub

Sub Lit_dossier(ByRef dossier)
Ligne = Ligne + 1
Cells(Ligne, 1) = dossier.Path
For Each d In dossier.SubFolders
Lit_dossier d
Next
End Sub

Merci par avance

Cdl

Infogroup