Calcul de sous-classeur VBA

Bonjour,

Je suis nouveau sur le site et pour l'avoir utilisé plusieurs fois ça m'a beaucoup aidé.

J'ai un problème avec une macro que je vous expose, Je ne suis pas familier avec le calcul des classeurs.

J'ai un répertoire avec des dossiers et dans chaque dossier il y a des sous-dossiers et dans chaque sous-dossier, des fichiers (PDF). J'arrive à calculer le nombre de dossiers et de sous dossiers, mais je voudrais ajouter un code de façon a faire une boucle pour calculer le nombre de fichier PDF dans chacun de mes sous dossiers. Comment je peux le faire ?

Merci beaucoup

Voici le bout de code que j'utilise :

Sub Compter()
chemin = "Monlien"
CompterRep (chemin)
End Sub

Function CompterRep(chemin As String) As Integer
'Compte le nombre de sous-répertoires dans le chemin spécifier
'En ajoutant 2 lignes peut retourner tout les Sous/Sous etc.. répertoires
Dim fs, f, sf, Nb
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(chemin)
Set sf = f.SubFolders
Nb = f.SubFolders.Count - 1
Range("A1") = Nb & " Jours"

Je voudrais continuer sur mon code à partir d'ici

End Function

Salut,

Tu peux essayer ça à la suite de ton code

NbPdf = 0
i = 2
For Each Rep In sf
     For Each VFile In Rep.Files
          If Right(VFile.Name, 3) = "pdf" Then NbPdf = NbPdf + 1
     Next
     Sheets(1).Cells(i, 1) = NbPdf & " pdf dans le dossier " & Rep
     NbPdf = 0
     i = i + 1
Next

bonjour,

une autre proposition qui parcourt les répertoires de manière récursive

Sub aargh()
    rep = "D:"    ' répertoire à examiner
    MsgBox "total pdf's : " & kfif(rep, ligne)
End Sub

Function kfif(folder, ByRef ligne)
    k1 = 0 ' k1 nombre de fichiers pdf dans ce répertoire
    Set fold = CreateObject("Scripting.FileSystemObject").GetFolder(folder)
    On Error GoTo terr
    For Each f In fold.SubFolders
        Application.StatusBar = f
        If Right(f, 1) <> "\" Then k = k + kfif(f & "\", ligne) Else k = k + kfif(f, ligne) ' k nombre total de fichiers pdf trouvés
    Next
    For Each f In fold.Files
        If Right(f, 4) = ".pdf" Then k1 = k1 + 1
    Next
ici:
    ligne = ligne + 1
    Cells(ligne, 1) = folder & " : " & k1 & " pdf's"
    kfif = k1 + k
    Exit Function
terr:
    Resume ici
End Function

Salut

Merci pour vos réponses, j'essaye cela lundi au bureau et je vous tiens au courant

Bon week end

Salut

J'ai testé vos 2 codes et ils marchent parfaitement.

Seul bémol que j'essaye de régler, c'est la lenteur. Avec 4500 fichier a calculer ça prend environ 4 minutes à faire le tout :S

Merci beaucoup. Vous êtes au Top

bonjour,

ceci devrait améliorer un peu les performances

Dim t()
Sub aargh()
ReDim t(1 To 50000)
    rep = "D:"    ' répertoire à examiner
   MsgBox "total pdf's : " & kfif(rep, ligne)
   ReDim Preserve t(1 To ligne)
   Range("A1").Resize(ligne) = Application.Transpose(t)
End Sub

Function kfif(folder, ByRef ligne)
    k1 = 0 ' k1 nombre de fichiers pdf dans ce répertoire
   Set fold = CreateObject("Scripting.FileSystemObject").GetFolder(folder)
    On Error GoTo terr
    For Each f In fold.SubFolders
        'Application.StatusBar = f
        If Right(f, 1) <> "\" Then k = k + kfif(f & "\", ligne) Else k = k + kfif(f, ligne) ' k nombre total de fichiers pdf trouvés
   Next
    For Each f In fold.Files
        If Right(f, 4) = ".pdf" Then k1 = k1 + 1
    Next
ici:
    ligne = ligne + 1
    t(ligne) = folder & " : " & k1 & " pdf's"
    kfif = k1 + k
    Exit Function
terr:
    Resume ici
End Function