Comptage de dossiers et sous-dossiers

Le
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Mishell
Le #18534591
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" 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


Infogroup
Le #18536031
Merci beaucoup Mishell, c'est impeccable

Cordialement

Infogroup






"Mishell" 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" 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






Publicité
Poster une réponse
Anonyme