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

jeanmi · 2 Janvier 2022

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 · 2 Janvier 2022

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.

Download Microsoft Power Query pour Excel from Official Microsoft Download Center

Microsoft Power Query pour Excel est un complément Excel qui améliore l'expérience du décisionnel libre-service dans Excel en simplifiant la récupération des données, l'accès et la collaboration.

www.microsoft.com

cordialement

chris · 2 Janvier 2022

Bonjour tous et bonne année

Hasco à dit:
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...

Usine à gaz · 2 Janvier 2022

Bonjour Hasco,
Pour pour ce retour et le fichier.
Malheureusement, je n'utilise pas PowerQuery
Il me faudrait refaire tous mes fichiers que j'ai mis des années à faire.
Je vais quand même voir ce que ça donne
lionel

Usine à gaz · 2 Janvier 2022

chris à dit:
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 · 2 Janvier 2022

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

chris · 2 Janvier 2022

Usine à gaz à dit:
Merci Chris = même réponse que pour Hasco
lionel

Nous répondions à jeanmi : tu as 2 pseudos ?

Usine à gaz · 2 Janvier 2022

Bon, allé, je me recouche lol
Bizarre, je n'ai qu'un pseudo
lionel,

chris · 2 Janvier 2022

re

A noter que le code de Hasco et PowerQuery sont tous deux nettement plus rapides que le code de fanch55

Mais le choix du répertoire est un plus

jeanmi · 2 Janvier 2022

Hasco à dit:

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

Hasco · 2 Janvier 2022

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

fanch55 · 2 Janvier 2022

chris à dit:
re

A noter que le code de Hasco et PowerQuery sont tous deux nettement plus rapides que le code de fanch55

Mais le choix du répertoire est un plus

Ca c'est le choix de "Shell.Application" qui est paradoxalement long selon le nombre de subfolders et la quantité mémoire disponible...

jeanmi · 2 Janvier 2022

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

Hasco · 2 Janvier 2022

Re

Pour en faire quoi ? Quel est le but final ?

cordialement

jeanmi · 2 Janvier 2022

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

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

jeanmi

XLDnaute Occasionnel

Hasco

XLDnaute Barbatruc

Download Microsoft Power Query pour Excel from Official Microsoft Download Center

Pièces jointes

chris

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

chris

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

chris

XLDnaute Barbatruc

jeanmi

XLDnaute Occasionnel

Hasco

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

jeanmi

XLDnaute Occasionnel

Hasco

XLDnaute Barbatruc

jeanmi

XLDnaute Occasionnel

Discussions similaires