recherche récursive avec scripting.filesystemobject

**patricktoulon** · 11/12/2016, 20h49

Bonsoir a tous
après une demande ressente d'un membre du forum , j'ai ressorti une vieillotte fonction de recherche récursive avec la librairie Scripting.filesystemobject
alors voila

j'ai virer les fonctions"dir" et employé le FSO pour les dossier et!! fichiers
j'ai ajouté aussi la possibilité de rechercher plusieurs extensions différentes ou carrément (tout fichier avec l'argument "all") des exemple sont démontrés dans la sub de test

sub de test

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'=======================================================================================================
'              OBJECT  : FONCTION DE RECHERCHE RECURSIVE AVEC L'OBJECT SCRIPTING.FILESYSTEMOBJECT      =
'                              createur  patricktoulon pour developpez.com                             =
'                                       date de création  27/06/2010                                   =
'Modification le  10/12/2016                                                                           =
'Modif 1:FSO sert aussi pour boucler sur les fichier                                                   =
'Modif 2:on peut maintenant rechercher plusieur extentions differentes                                 =
'  ou carrément tout les fichiers avec l'argument "all"                                                =
'                                                                                                      =
'=======================================================================================================
Option Explicit
Sub test()
    Dim tabl
    'exemple d'utilisation on va transposer la liste sur le sheets
    'on recherche les fichier pdf et jpg
    tabl = recherche_récursive("C:\Users\polux\Desktop\testrecursiverecheche", ".pdf,.jpg")    'chemin entre guillemets a adapter
    'on recherche les fichiers text
    'tabl = recherche_récursive("C:\Users\polux\Desktop\testrecursiverecheche", ".txt")    'chemin entre guillemets a adapter
    'on recherche tout les fichiers toutes extention confondues
    'tabl = recherche_récursive("C:\Users\polux\Desktop\testrecursiverecheche", "all")    'chemin entre guillemets a adapter
    ' exemple 1:depot dans le sheets en colonne A
    Sheets(1).Cells(1, 1).Resize(UBound(tabl), 1) = Application.Transpose(tabl)
    'exemple 2 remplisage dans une listbox
    'Userform1.listbox1.List = recherche_récursive("C:\Users\polux\Desktop\testrecursiverecheche", "all")' tout fichier
End Sub

fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Function recherche_récursive(dparent, ext, Optional L As String) As Variant
    Dim FSO As Object, oFolder As Object, folderItem As Object, sous_dossier As Object, Ficher, arrayext As Variant, i As Long
    Set FSO = CreateObject("scripting.filesystemobject")    ' on declare l'object
    If ext = "all" Then ext = ".,." 'on prend toute extention pour "all"
    arrayext = Split(ext, ",.") ' on split par le ",."
    ' regard sur les fichiers
    Set folderItem = FSO.GetFolder(dparent)    'on attribue a l'object.getfolder le dossier demandé'Scripting.Folder
    For Each Ficher In folderItem.Files    'on boucle sur les fichiers qui sont dans ce dossiers
        For i = 0 To UBound(arrayext)
            If Ficher Like "*" & arrayext(i) Then L = L & Ficher & vbCrLf
        Next
    Next
    'regard sur les dossiers
    Set oFolder = FSO.GetFolder(dparent)    'on attribue a l'object.getfolder le dossier demandé
    For Each sous_dossier In oFolder.SubFolders    'on boucle sur les dossiers qui sont dans ce dossiers
        recherche_récursive sous_dossier.Path, ext, L    ' on rappelle la fonction avec pour argument le chemin du sous dossier ainsi que l'extension et L qui est déjà peut être remplie
    Next sous_dossier
    recherche_récursive = Split(L, vbCrLf)    'on coupe la liste par les saut de lignes on a maintenant un array la fonction devient cet array
End Function

elle commençait a vieillir un peu un petit coup de lifting ca mange pas de pain
voila qu'en pensez vous

**Marc-L** · 12/12/2016, 10h11

Salut Patrick !

Envoyé par patricktoulon

j'ai virer les fonctions"dir" et employé le FSO pour les dossier et!! fichiers

Comme déjà démontré sur ce site, FSO est tellement plus lent que Dir.
Exemple d'un scan FSO ayant besoin de deux minutes et quinze secondes alors que sous Dir cela prend moins de 20s !
(A relativiser car Dir a l'air d'être un peu plus favorisé par le cache mais s'avère quasi toujours bien plus rapide.)
La raison pour laquelle je préfère me cantonner au standard VBA …

Cependant la bibliothèque FSO externe au VBA est bien plus facile à prendre en main pour les débutants,
enfin ceux qui ne lisent pas l'aide VBA interne et ne testent pas par eux-mêmes
tandis que les autres, les bons, s'en sortiront bien avec juste la fonction VBA Dir …

FSO a aussi un avantage pour les cas spéciaux : noms de fichiers avec caractères non Windows créés sur un autre OS,
dossiers / fichiers cachés ou système, réseau, … là Dir peut ne pas les voir même en paramétrant bien ses options …

Pour résumé dans les cas standards (en gros 90% des besoins), j'utilise Dir sinon pour les spéciaux cela peut être FSO.

Sans oublier les API Windows s'avérant les plus efficaces comme déjà démontré par kiki29 (Salut Philippe !).

_________________________________________________________________________________________________________
Je suis Paris, Nice, Bruxelles, Charlie, …

**patricktoulon** · 12/12/2016, 11h22

re
Bonjour MarcL
oui je suis d'accords c'est qu'elle est viellote cette fonction
il est certain que aujourd'hui j'utilise dir en récursivité
mais ca reste encore très complexe a monter pour un débutant sur tout que dir n'est pas récursif et exige une tamponade ( fermeture du dir sur itemfolder)
j 'ai remis au gout du jour car pour moi elle est tellement simple a comprendre et a utiliser que même un débutant ne peut pas y perde son latin
je vais l'essayer sur un disque complet bien chargé avec l'argument "all" voir si c'est si gênant

EDIT:
bon je viens de faire l'essai
il faut exclure les dossiers system comme "RECYCLE.BIN,SYSTEM INFORMATION"etc... qui génère une erreur du au autorisation

**patricktoulon** · 12/12/2016, 12h22

voila la meme avec dir

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
31
32
33
34
35
36
37
38
39
 
Option Explicit
Sub test2()
    Dim mesfichiers, chemin As String, ExT As String
    chemin = "H:\"    ' racine pour la recherche
    ExT = ".mp3,.txt"    ' exemple avec plusieurs extentions recherchés
    'ExT = "all"    ' extention de fichiers recherchés
    mesfichiers = cherche(chemin, ExT)    '  ||mesfichier|| deviendra un tableau de nom de fichiers selon les condition précédemment énumérée
    'exemple d'utilisation: depose la liste des fichier trouvés dans le sheets
    If UBound(mesfichiers) > 0 Then Cells(1, 1).Resize(UBound(mesfichiers), 1) = Application.Transpose(mesfichiers)
End Sub
Function cherche(dossier, ExT, Optional texte As String)
    Dim chemin As String, itemsvu As String, nbitemsVu As Long, i As Long, ArrayExT
    chemin = dossier & "\"
    itemsvu = Dir(chemin, vbDirectory)
    If ExT = "all" Then ExT = ".,"
    ArrayExT = Split(ExT, ",")
    Do
        nbitemsVu = nbitemsVu + 1
        If itemsvu <> "." And itemsvu <> ".." Then
            On Error Resume Next
            If (GetAttr(chemin & itemsvu) And vbDirectory) = vbDirectory Then
                Call cherche(chemin & itemsvu, ExT, texte)
                Err.Clear
                'après avoir examiné le sous-dossier, il faut repositionner Dir sur l'entrée suivante
                'car la fonction dir n'est pas récursive et a donc perdue la dernière position
                'on réinitialise donc Dir et repositionne le flag à la bonne place avec nbitemsVu
                itemsvu = Dir(chemin, vbDirectory)
                For i = 1 To nbitemsVu - 1: itemsvu = Dir: Next i
            Else
                For i = 0 To UBound(ArrayExT)
                    If itemsvu Like "*" & ArrayExT(i) Then texte = texte & chemin & "\" & itemsvu & vbCrLf
                Next
            End If
        End If
        itemsvu = Dir
    Loop While itemsvu <> ""
    cherche = Split(texte, vbCrLf)
End Function

voila

**Marc-L** · 12/12/2016, 12h36

Ayant déjà publié des codes avec Dir sur ce forum (et j'en ai encore sous le coude) …

Donc non je n'y tiens pas : j'ai juste apporté une précision quant à l'efficacité de FSO dans ce domaine.

**patricktoulon** · 12/12/2016, 15h12

re
oulah!!! avec dir j'ai un peu plus de 7000 fichier dans le disque H

avec scripting.filesystemobject j'en plus de 12000

y a un blême la
je me disais aussi que dir était bien trop rapide et le nombre est bien 12563 fichier j'ai vérifié
je ne vois pas ce qui cloche dans la fonction dir

**Marc-L** · 12/12/2016, 16h19

Je n'ai jamais eu une telle différence !
Du reste dans une discussion Robert avait testé ma procédure de son côté, la différence était minime.

Comme déjà évoqué, elle peut s'expliquer par les caractères utilisés dans les noms de dossiers / fichiers,
les attributs des fichiers (FSO est plus long car il prend tout par défaut), …

Je pencherais plutôt pour un souci de ton code du côté de la portée des variables à première vue ! (sans tester donc)

**patricktoulon** · 12/12/2016, 17h54

re
bon j'ai compris
le on error résume nest et err.clear ne fonctionne pas chez moi
en fait ca plante dans mon dossier musique j'ai des dossiers/fichier en lecture seule j'ai regarder aussi l'onglet sécurité
et j'ai une autorisation sur NPnetworkSvC par ce que je les ai indexé avec WMP et media center
impossible de supprimer cela car c'est herité une histoire de fou un casse tète chinois

conclusion rien a faire dir plante ca fait plus de 2 heures que je cherche
avec Scripting pas de soucis
sur un petit dossier en vu d'une application fait avec excel je suis sur que sa doit être intéressant et quoi que!!!!

sir dir est sensé etre plus rapide mais que je suis obligé de tricoté a cause des autorisation et autre

et que je veux lister le disque dur "dir" est loin d'atteindre mes attentes

ou je peux trouver toute les constantes "getattr(chemin)"?

je vais voir avec ca

**Marc-L** · 12/12/2016, 18h21

Pour moi ton code Dir est à revoir, des lignes me gênent, surtout en récursif …

J'avais un anti-virus verrouillant un dossier d'une partition (quarantaine),
il fallait le même traitement tant pour Dir que côté FSO.

Et les constantes sont directement visibles dans l'aide VBA de la fonction GetAttr !

**patricktoulon** · 12/12/2016, 18h36

re
bon j'ai trouvé sur MSDN le getattr mais c'est choux blanc j'ai meme mis la condition sur le getattr a 52(nom invalide)
non vraiment dir en récursif sur un disque ca vaut pas le coup
tu imagine un peu aller modifier les termes de sécurités a chaque fois
non pas le coup
et perso j'ai fait le test sur un dossier avec 1200 nouveau fichier text
avec txt comme argument c'est aussi rapide pour fso que dir (chemin,"*.txt")
en fait fso est plus long comme tu dis parce que fso prends tout les fichiers mais en contraignant les extensions c'est bonnet blanc

reste le contexte peut être pour une petite app avec un dossier dir peut faire l'affaire mais la je sui épuisé de tourner en rond

je le redis purée de purée qu'est ce qui font chez Microsoft hein on devrait les mettre en prison

**Marc-L** · 12/12/2016, 18h41

Pas de souci particulier de mon côté avec Dir et comme souvent FSO rame, Dir s'impose par défaut !

De plus ton code Dir ne me plait pas, je ne vois pas déjà comment il peut fonctionner !
Teste-le sur un p'tit dossier avec deux p'tits sous-dossiers, tu verras bien …

Dans certains cas il m'est arrivé d'utiliser le Dir de l'Invite de commandes (DOS) pour éviter FSO !

**patricktoulon** · 12/12/2016, 22h33

re j'ai essayé mon mode dir dans un dossier de test avec subdossier etc... ca match

mai a l'analyse d'un disque complet il manque plus de la moitié
j'ai supprimer le fichiers qui me posaient soucis

**patricktoulon** · 12/12/2016, 23h45

re
bon pas moyen de trouver ce qui va pas c'est une énigme
j'ai pourtant remplacer la variable texte par un tablo
rien n'y fait
je vais poster sur le forum pour voir si quelqu'un a une réponse

**Marc-L** · 13/12/2016, 02h34

J'ai testé ton code sur une p'tite partition :
déjà certains résultats ne sont pas directement exploitables car souvent l'anti-slash est doublé …

J'ai comparé avec mon code - utilisant aussi Dir - publié dans une discussion de ce site : il manque cinq fichiers de ton côté !
Ces cinq fichiers sont normaux comme les autres : pas de droits ni d'attributs particuliers …

Ceci dit, ton code fonctionne mieux que je ne le pensais, j'avais mal vu pour une instruction ne me plaisant pas
et au premier abord je ne vois pas pourquoi ton code loupe des fichiers …

Edit : avec FSO je trouve le même nombre de fichiers qu'avec mon code utilisant Dir.

**jijie** · 04/06/2022, 23h24

Envoyé par Marc-L

J'ai testé ton code sur une p'tite partition :
déjà certains résultats ne sont pas directement exploitables car souvent l'anti-slash est doublé …

Bonsoir,

c'est un peu tard, mais le problème était là :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
                For i = 0 To UBound(ArrayExT)
                    If itemsvu Like "*" & ArrayExT(i) Then texte = texte & chemin & "\" & itemsvu & vbCrLf
                Next

Remplacé par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
                For i = 0 To UBound(ArrayExT)
                    If itemsvu Like "*" & ArrayExT(i) Then texte = texte & chemin  & itemsvu & vbCrLf
                Next

recherche récursive avec scripting.filesystemobject

Macros et VBA Excel

Discussions similaires

Partager

Partager