Discussion :

[patricktoulon]

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]

Salut Patrick !

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]

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]

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]

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]

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