XL 2010 Compter les fichiers dans rep et sous rep par type

jeanmi

XLDnaute Occasionnel
Bonjour à tous et bonne année,

J’ai récupérer une macro de #camarchepas : https://www.excel-downloads.com/threads/macro-pour-compter-des-fichiers-pdf.221517/ (post #3) que j’ai essayé d’adapter à ce que je cherche à faire, compter tous les fichiers qui sont dans le rep et sous rep et sous/sous rep et les affecter à des variables.

Le problème est que cela ne compte pas tous mes fichiers.

Voici l’architecture de mon répertoire à comptabiliser :

Répertoire A (le plus haut)

Sous répertoire B

Plusieurs Sous/sous répertoire de B1 à Bx avec des fichiers PDF dans chacun (fichiers pas comptabilisés)

Sous répertoire C avec des fichiers docm (fichiers comptabilisés)

Sour répertoire E de plusieurs types (fichiers comptabilisés)

Des fichiers dans le répertoire A, un fichier xlsm et un fichier zip (fichiers nom comptabilisés)

Pouvais vous m’aider à adapter cette macro.

Voici le code que j'ai essayé d'adapter :

VB:
Sub test_v()

Dim FileSystemObject As Object, SsRep As Object, F As Object
Dim Compteur As Long
Dim Chemin As String, E_pdf As String

Set FileSystemObject = CreateObject("Scripting.FileSystemObject")

'le chemin
Chemin = "D:\A-essai"

For i = 1 To 5

If i = 1 Then Extension = ".pdf"
If i = 2 Then Extension = ".docm"
If i = 3 Then Extension = ".xlsx"
If i = 4 Then Extension = ".png"
If i = 5 Then Extension = ".zip"

For Each SsRep In FileSystemObject.GetFolder(Chemin).SubFolders

    For Each F In SsRep.Files
    If InStr(1, F.Name, Extension) > 0 Then Compteur = Compteur + 1
    Next F
    
Next SsRep
      
    If i = 1 Then nb_pdf = Compteur: MsgBox "nombre de fichiers pdf : " & Compteur
    If i = 2 Then nb_docm = Compteur: MsgBox "nombre de fichiers docm : " & Compteur
    If i = 3 Then nb_xlsx = Compteur: MsgBox "nombre de fichiers xlsx : " & Compteur
    If i = 4 Then nb_png = Compteur: MsgBox "nombre de fichiers png : " & Compteur
    If i = 5 Then nb_zip = Compteur: MsgBox "nombre de fichiers zip : " & Compteur
 
  Compteur = 0
 
Next i

nb_total = nb_pdf + nb_docm + nb_xlsx + nb_png + nb_zip
 
MsgBox "Nombre total de fichiers  : " & nb_total


End Sub

Merci d’avance pour l'aide

Cordialement
 

Hasco

XLDnaute Barbatruc
Bonjour,

Dans le fichier joint vous trouverez le module ci-dessous.
Ouvre la fenêtre exécution de l'éditeur visual basic application par CTRL+G si elle n'est pas déjà ouverte.
La premiere procédure y affichera les nombres de fichier par extension du dossier et ses sous-dossiers
VB:
Option Explicit
Dim oDic As Object

Sub CompteFichiersParExtensions()
    Dim Fso As Object
    Dim Dossier As String
    Dim Ext As Variant ' pour boucle for
    '
    ' Créer un dictionnaire qui contiendra les extensions et les nombres de fichier par extension
    Set oDic = CreateObject("scripting.dictionary")
    oDic("pdf") = 0
    oDic("docm") = 0
    oDic("xlsx") = 0
    oDic("png") = 0
    oDic("zip") = 0
    '
    ' Modifier le chemin
    Dossier = "Z:\Excel\xldnautes"
    Set Fso = CreateObject("Scripting.FileSystemObject")
    '
    ' Explorer le premier dossier
    ExploreDossier Fso.GetFolder(Dossier)
    '
    ' Parcourir le dictionnaire pour afficher les extensions et nombres de fichiers.
    For Each Ext In oDic.keys
        Debug.Print Ext, oDic(Ext)
    Next
End Sub

Sub ExploreDossier(Dossier)
    Dim SousDossier, Fichier, Ext
    '
    ' Parcourir les clefs du dictionnaires
    For Each Ext In oDic.keys
        ' Trouver le premier fichier de cette extension
        Fichier = Dir(Dossier.path & "\*." & Ext)
        Do While Fichier <> ""
            ' le compter
            oDic(Ext) = oDic(Ext) + 1
            ' passer au suivant
            Fichier = Dir()
        Loop
    Next Ext
    '
    ' Explorer le sous dossier suivant
    For Each SousDossier In Dossier.SubFolders
        ExploreDossier SousDossier
    Next
End Sub

qui affichera le nombre total de fichiers par extension dans le dossier et ses sous-dossiers.

Si vous pouvez installer PowerQuery en complément (gratuit), celui-ci pourrait le faire en une requête de quelques lignes.

cordialement
 

Pièces jointes

  • ExplorerDossiers.xlsm
    21.3 KB · Affichages: 8
Dernière édition:

chris

XLDnaute Barbatruc
Bonjour tous et bonne année
Si vous pouvez installer PowerQuery en complément (gratui), celui-ci pourrait le faire en une requête de quelques lignes.
J'allais posté la même remarque.
En plus on peut lister tous les les types ou avoir un tableau de choix pour paramétrer ce qu'on veut.

Et c'est bien plus simple que VBA à comprendre.
VBA qui nécessite la librairie Microsoft Scripting Runtime

Le problème du code initial est la non récurrence pour descendre dans les niveaux d'arborescence...
 
Dernière édition:

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour tous et bonne année

J'allais posté la même remarque.
En plus on peut lister tous les les types ou avoir un tableau de choix pour paramétrer ce qu'on veut.

Et c'est bien plus simple que VBA à comprendre

Le problème du code initial est la non récurrence pour descendre dans les niveaux d'arborescence
Merci Chris = même réponse que pour Hasco :)
lionel :)
 

fanch55

XLDnaute Barbatruc
Bonjour à tous et bonne année à ceux auxquels je ne l'ai pas encore souhaitée .

Autre méthode:
VB:
Option Explicit
Dim F
Sub Nb_Files()
Dim Source As Range
Dim Msg As String
Dim Elem
   
    Set F = CreateObject("Scripting.Dictionary")
    Set Source = ActiveSheet.[A1]

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "Dossier à explorer"
        .InitialFileName = Source & "\"
        If .InitialFileName = "" Then _
        .InitialFileName = CreateObject("Shell.Application").Namespace(&HE).self.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
            Application.ScreenUpdating = False
            Source = .SelectedItems(1)
            Get_Files Source.Text
            For Each Elem In F
                Msg = Msg & Elem & " nb=" & F(Elem) & vbLf
            Next
            MsgBox Msg
        End If
    End With
   
    Application.Goto Source, True
End Sub
Sub Get_Files(Folder)
Dim File    As Object
Dim Ext
    For Each File In CreateObject("Shell.Application").Namespace(Folder).Items
        If File.IsFolder Then
            Get_Files File
        Else
            Ext = Split(File, "."): Ext = Ucase(Ext(UBound(Ext)))
            F(Ext) = F(Ext) + 1
        End If
    Next

End Sub
 
Dernière édition:

jeanmi

XLDnaute Occasionnel
Bonjour,

Dans le fichier joint vous trouverez le module ci-dessous.
Ouvre la fenêtre exécution de l'éditeur visual basic application par CTRL+G si elle n'est pas déjà ouverte.
La premiere procédure y affichera les nombres de fichier par extension du dossier et ses sous-dossiers
VB:
Option Explicit
Dim oDic As Object

Sub CompteFichiersParExtensions()
    Dim Fso As Object
    Dim Dossier As String
    Dim Ext As Variant ' pour boucle for
    '
    ' Créer un dictionnaire qui contiendra les extensions et les nombres de fichier par extension
    Set oDic = CreateObject("scripting.dictionary")
    oDic("pdf") = 0
    oDic("docm") = 0
    oDic("xlsx") = 0
    oDic("png") = 0
    oDic("zip") = 0
    '
    ' Modifier le chemin
    Dossier = "Z:\Excel\xldnautes"
    Set Fso = CreateObject("Scripting.FileSystemObject")
    '
    ' Explorer le premier dossier
    ExploreDossier Fso.GetFolder(Dossier)
    '
    ' Parcourir le dictionnaire pour afficher les extensions et nombres de fichiers.
    For Each Ext In oDic.keys
        Debug.Print Ext, oDic(Ext)
    Next
End Sub

Sub ExploreDossier(Dossier)
    Dim SousDossier, Fichier, Ext
    '
    ' Parcourir les clefs du dictionnaires
    For Each Ext In oDic.keys
        ' Trouver le premier fichier de cette extension
        Fichier = Dir(Dossier.path & "\*." & Ext)
        Do While Fichier <> ""
            ' le compter
            oDic(Ext) = oDic(Ext) + 1
            ' passer au suivant
            Fichier = Dir()
        Loop
    Next Ext
    '
    ' Explorer le sous dossier suivant
    For Each SousDossier In Dossier.SubFolders
        ExploreDossier SousDossier
    Next
End Sub

qui affichera le nombre total de fichiers par extension dans le dossier et ses sous-dossiers.

Si vous pouvez installer PowerQuery en complément (gratuit), celui-ci pourrait le faire en une requête de quelques lignes.


cordialement
Bonjour #Hasco, à tous,

Merci pour la réponse, ça fonctionne super bien.
Maintenant comment récupérer toutes ces infos dans des variables comme je le souhaitais ? pas par un Ctrl + G

cordialement
 
Dernière édition:

Hasco

XLDnaute Barbatruc
Re,

Elles sont déjà dans des variables !

Pour l'objet oDic (scripting dictionary) :
sa propriété Keys renvoie un tableau contenant les clefs du dictionnaire (pour vous les extensions des fichiers)
sa propriété Items renvoie un tableau contenant les valeurs du dictionnaire, correspondant à chaque clefs.

Exemple :
VB:
    Range("A2").Resize(oDic.Count) = Application.Transpose(oDic.Keys)
    Range("B2").Resize(oDic.Count) = Application.Transpose(oDic.Items)

Mettra en A2:A? les noms de clefs et en B2:B? les valeurs de clefs.

Cordialement
 

jeanmi

XLDnaute Occasionnel
re # Hasco, à tous,

merci pour la réponse,
je ne suis pas sur d'avoir compris.
si je veux que chaque type de fichier soit dans une variable A pour pdf, B pour Doc ,C pour Xlsm , D pour png et E pour zip, comment faire ?
cordialement
 

jeanmi

XLDnaute Occasionnel
re

comparer par rapport à un résultat qui devrait-être obtenue en fonction d'une macro qui réalise la création des docs et la mise en places d'autres doc dans les répertoires qui vont bien, afin de vérifier que le travail est conforme avant la publication.
cordialement
 

Discussions similaires

Statistiques des forums

Discussions
300 889
Messages
1 988 142
Membres
210 084
dernier inscrit
Fastambu