VBA. Nombre de sous-répertoires

Re DAH;

Sub Essai()
MsgBox DirCount("c:mes documents")
End Sub

Function DirCount(iPath As String) As Integer
If Not Right(iPath, 1) = "" Then iPath = iPath & ""
Dim CurPath As String: CurPath = Dir(iPath, vbDirectory)
While CurPath <> ""
If CurPath <> "." And CurPath <> ".." Then
If GetAttr(iPath & CurPath) And vbDirectory Then DirCount = DirCount + 1
End If
CurPath = Dir()
Wend
End Function

MP

"DAH" <dah@anti.spam.fr> a écrit dans le message de
news:bo58ja$pe1$1@biggoron.nerim.net...

Bonjour,

J'ai fait une macro qui doit me retourner le nombre de sous-répertoire d'un
répertoire donné mais ça ne fonctionne pas... ça me donne en fait le nombre
de sous-répertoires et de fichiers placé sous le répertoire Rep...

Function NbSsRep(Rep As String) As Integer
Dim MyPath As String
Dim MyName As String
Dim Nb As Integer

Nb = 0
MyName = Dir(Rep, vbDirectory)
Do While MyName <> ""
Nb = Nb + 1
MyName = Dir
Loop
NbSsRep = Nb - 2 'pour le "." et le ".."
End Function

Sub Essai()
MsgBox NbSsRep("C:tmp")
End Sub

Merci d'avance pour votre aide.
--
@+
David

Bonsoir,

Une approche possible :

'======================= Sub Essai()
s$ = "D:fsdatas6OfficeVBA"
NbDeDossiers s, x
MsgBox x
End Sub

Sub NbDeDossiers(DossierRacine$, Cpte, Optional SsDossiers As Boolean = True)
Dim fso As Object, Dossier As Object, sousRep As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(DossierRacine)
Cpte = Cpte + Dossier.SubFolders.Count
'traitement récursif des sous dossiers
If SsDossiers Then
For Each sousRep In Dossier.SubFolders
NbDeDossiers sousRep.Path, Cpte
Next sousRep
End If

End Sub 'fs
'=======================
FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

Bonjour,

J'ai fait une macro qui doit me retourner le nombre de sous-répertoire d'un
répertoire donné mais ça ne fonctionne pas... ça me donne en fait le nombre
de sous-répertoires et de fichiers placé sous le répertoire Rep...

Function NbSsRep(Rep As String) As Integer
Dim MyPath As String
Dim MyName As String
Dim Nb As Integer

Nb = 0
MyName = Dir(Rep, vbDirectory)
Do While MyName <> ""
Nb = Nb + 1
MyName = Dir
Loop
NbSsRep = Nb - 2 'pour le "." et le ".."
End Function

Sub Essai()
MsgBox NbSsRep("C:tmp")
End Sub

Merci d'avance pour votre aide.
--
@+
David