Besoin d'explications sur une procédure.

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

Ce que je souhaite faire :

En supposant l'arborescence suivante (très nombreux sous-dossiers de la forme IDxxxx):

P:\TOTO\
ID1234
ID3254
ID5644
ID6756
ID....

Dans ma procédure, j'affecte le dossier "P:\TOTO" à la variable "MonRepertoire". Les dossiers IDxxxx se situent juste en dessous du dossier TOTO.

La procédure scrute alors tous les sous-dossiers IDxxxx et regarde s'il n'y a pas un fichier du type *.docm. Si un fichier est trouvé, le programme affiche le résultat suivant :

En cellule A1 : IDxxxx et juste à côté (cellule B1) le nom du fichier ayant l'extension docm.
Le programme boucle sur tous les sous-dossiers et affiche quand cela est nécessaire le résultat en sautant une ligne à chaque fois.

Ce que j'ai trouvé sur le net :

J'ai trouvé sur le net une procédure qui réponds à mon besoin (j'y ai apporté quelques modifs) cependant j'aurais besoin de quelques explications car je souhaiterais y apporter quelques modifications. Ci-dessous la procédure :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 Option Explicit Sub ListeFichiersRepert() Dim Fso As Object Dim MonRepertoire As String, f As Object, x As Integer Dim f1 As Object, f2 As Object Set Fso = CreateObject("Scripting.FileSystemObject") MonRepertoire = InputBox("Enter the root directory", "Root directory", "P:\TOTO") ' x = 1 For Each f In Fso.GetFolder(MonRepertoire).Files If f.Name Like "*.docm*" Then Cells(x, 1).Value = f.Name x = x + 1 End If Next f x = 1 For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders Cells(x, 2).Value = f1.Name x = x + 1 For Each f2 In f1.Files If f2.Name Like "*.docm*" Then Cells(x - 1, 3).Value = f2.Name x = x + 1 End If Next f2 x = x - 1 Next f1 End Sub
Après avoir exécuté la macro voici ce que j'obtiens :

Pièce jointe 467746

Mes interrogations :

Pourquoi lorsque j'exécute la macro le premier résultat IDxxxx est-il situé en cellule B1 ? Dans la première boucle x étant égal à 1 le résultat devrait être affiché en cellule (1,1) ?
Pourquoi les ID ne sont-ils pas dans l'ordre alphabétique ? Il commence par l'ID5073, suivi de l'ID4621 puis ID4694_1 ... ?
La première boucle semble traiter des fichiers et la seconde des dossiers ?
Pourriez vous m'expliquer ce que fait la ligne de commande : For Each f In Fso.GetFolder(MonRepertoire).Files ?
De façon générale comment fonctionne cette procédure ? Boucles ?

Merci par avance.

Cdlt.
Jérôme.

17/04/2019, 16h49
mercatog

Bonjour

La première boucle cherche les fichiers .docm dans le répertoire d'origine et les écrits en colonne A (Tu n'en as pas)
Ensuite la seconde parcourt les sous répertoires et écrit leur noms en colonne B
Enfin une troisième boucle pour chaque sous répertoire écrit les noms des fichiers .docm en colonne C
17/04/2019, 18h22
licpegpon

Merci beaucoup.
J ai remarqué qu il affichait l ID du dernier dossier (dernière ligne de la colonne B) avec aucun nom de fichier dans la colonne juste à sa droite....ne serait il pas possible de supprimer cet ID puisque il n'y a pas de fichier doc dans ce dernier dossier ?
Cdlt.
Jérôme

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub ListeFichiersRepert()
Dim Fso As Object, f As Object, f1 As Object, f2 As Object
Dim MonRepertoire As String, Ext As String
Dim x As Long
 
MonRepertoire = InputBox("Enter the root directory", "Root directory", "P:\TOTO")
Ext = "*.docm"
 
Set Fso = CreateObject("Scripting.FileSystemObject")
With Worksheets("feuil1")
    For Each f In Fso.GetFolder(MonRepertoire).Files
        If f.Name Like Ext Then
            x = x + 1
            .Cells(x, 1).Value = f.Name
        End If
    Next f
 
    x = 0
    For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
        For Each f2 In f1.Files
            If f2.Name Like Ext Then
                x = x + 1
                .Cells(x, 2).Value = f1.Name
                .Cells(x, 3).Value = f2.Name
            End If
        Next f2
    Next f1
End With
Set Fso = Nothing
End Sub

18/04/2019, 14h40
licpegpon

Merci Mercatog. Ca fonctionne parfaitement !!

Cdlt.
Jérôme.