XL 2016 lire des sous-dossiers ou fso

[MMEZ]

Bonjour,
Je souhaite en savoir plus sur fso.

Ma question : En ai-je vraiment besoin pour faire une boucle qui lirait les sous-dossiers d'un dossier ?

Bonne journée

 

[Dranreb]

Bonjour.
Non, pas absolument, des Dir le permettent aussi, mais c'est plus compliqué, surtout si la référence Microsoft Scripting Runtime est cochée, ce qui apporte une assistance confortable à un codage utilisant le FileSystemObject de la bibliothèque Scripting et ses types Folder et File.

 

[patricktoulon]

Bonjour
et bien ça dépend de ton besoins en fait
1° si tu a besoins de lister les fichiers d'un dossier et rien que ceux là alors non
2° si tu recherche un fichier dans un des dossiers dans un autre dossier tu va alors avoir besoins d'un appel récursif
3° si tu veux lister Absolument tout les fichiers présents dans un dossier sous dossiers compris là aussi tu aura besoins d'un appel récursif

pourquoi faut il prévoir un appel récursif dans ta fonction
et bien c'est simple si il n'y a pas de de sous dossier il n'y aura pas d'appels récursifs donc il n'y a aucun ralentissement
tu peux même affubler ta fonction d'un argument boolean pour décider si oui ou non les appels récursifs devront être fait

quand à FSO attention si il est mal manipulé il est extrêmement lent sur un dossier bien rempli avec sous dossiers


@Dudu2 et moi avons travaillé la dessus
le fonction que @Dudu2 et moi avons mis au point avec fso
je viens justement d'ajouter le choix récursif ou pas et les nom de dossier ou pas

'**************************************************************
'fonction récursive pour lister les fichiers d'un disque ou dossier
'Utilisation de filesystemobject(FSO)
'Auteurs Dudu2 et patricktoulon  sur exceldownload
'version 1.5
'Date:08/02/2021
'mise en place du principe (Part name) valable aussi pour (si juste extension demandée:ex;[*.XXX])
'suppression du stockage des erreurs et des msgbox d'erreur
'suppression commentaires
'utilisation d'une fonction de transposition de l'array simplifiée (horizontal(1 dim) To vertical(2 dim))pour palier au limite de la fonction transpose d'excel

'Date:08/02/2021
'accélération du processus
'en ajoutant du test dir non bloquant pour zapper les dossiers
'ne contenant pas de fichier avec l'extension ou la partie du nom demandée
'Date:13/02/2021
'remplacement du bloc  <<if takeit>> par un jumping (etiquette "ScanFolder")
'pour jumpé directement sur la boucle des dossiers on  zappe directement la partie du code boucle ofile si pas de fichier

'Date:25/04/2021
'ajout de la gestion d'appels récursifs (on le décide au départ )
'la fonction a donc un argument en plus
'****************************************************************
Option Explicit
Option Compare Text
Dim Appelcount
Dim countdoss
Function TransposeArray(arr)    ' fonction de transposition pour palier au limites de la fonction transpose d'excel
    Dim tbl(), I&: ReDim tbl(LBound(arr) To UBound(arr), 1 To 1)
    For I = LBound(arr) To UBound(arr): tbl(I, 1) = arr(I): Next
    TransposeArray = tbl
End Function
'
Sub listeFSOGOSUB()
    Dim Table As Variant, tim, Répertoire, Intresult
    Dim REPSOMMAIRE As Object, cheminsommaire$
    ActiveSheet.Range("A1:A" & Rows.Count).ClearContents
    With Application.FileDialog(msoFileDialogFolderPicker)
        Intresult = .Show
        If Intresult <> 0 Then Répertoire = .SelectedItems(1) & "\" Else Exit Sub
    End With
    tim = Timer
    Const Ext$ = "*"        'exemple de recherche de tout fichiers
    'Const Ext$ = "*.txt"        'exemple de recherche de tout fichiers avec extension précise
    'Const Ext$ = "*toto.txt"    'exemple de recherche de tout fichier ayant la fin du nom
    'Const Ext$ = "toto*.txt"    'exemple de recherche de tout fichier ayant pour début du nom
    'Const Ext$ = "*toto*.txt"   'exemple de recherche de tout fichier ayant une partie  du nom
    Appelcount = 0    '
    countdoss = 0

    'Table = FSO_List_FICHIERS2(Répertoire, Ext)    ' exemple d'appel non recursif et sans les noms de dossier
    'Table = FSO_List_FICHIERS2(Répertoire, Ext, True)    ' exemple d'appel  recursif et sans les noms de dossier
    Table = FSO_List_FICHIERS2(Répertoire, Ext, True, True)    ' exemple d'appel non recursif avec  les noms de dossier

    If IsArray(Table) Then
        Table = TransposeArray(Table)
        tim = Format(Timer - tim, "#0.000 S")

        MsgBox UBound(Table) & " fichier/dossiers(s) <""" & Ext & """> trouvé(s) dans le répertoire <" & Répertoire & "> en " & tim & " s/" & _
               vbCrLf & "pour " & Appelcount & " appels de la fonction dans dossier et sous dossier" & vbCrLf & countdoss & " dossiers utilement explorés"

        ActiveSheet.Range("A1").Resize(UBound(Table)).Value = Table

    Else
        MsgBox "Aucun fichier dans le répertoire <" & Répertoire & ">" & vbCrLf & "ayant une partie du nom contenant  " & Ext
    End If
End Sub

Function FSO_List_FICHIERS2(ByVal Folder As Variant, Optional PartName As String = "", Optional recursif As Boolean = False, Optional WithFolder As Boolean = False) As Variant
    Static tbl() As String: Static NbFichiers As Long: Static oFSO As Object
    Appelcount = Appelcount + 1
    countdoss = countdoss + 1
    Dim oDir As Object, oSubDir As Object, oFile As Object, First_Call As Boolean, TakeIT As Boolean

    If TypeOf Folder Is Object  Then                            'si ce nest pas le premier appel  Foler est un objet folder membre de FSO
        First_Call = False                                      'si ce nest pas le premier appel  on positionne First_Call a false des les 2d appel
        Set oDir = Folder                                       'si ce nest pas le premier appel  Odir est donc un object Folder membre de FSO
    Else                                                        'si c'est le premier appel Folder est de type string
        First_Call = True                                       'si c'est le premier appel first_call est a true
        Erase tbl                                               'si c'est le premier appel on eraze la variable tableau  <<tbl>>
        NbFichiers = 0                                          'si c'est le premier appel on met la variables NbFichiers à 0
        Set oFSO = CreateObject("Scripting.FileSystemObject")   'si c'est le premier appel on créée l'object FSO
        If Right(Folder, 1) <> "\" Then Folder = Folder & "\"   'si c'est le premier appel si le slach de fin on l'ajoute
        Set oDir = oFSO.getfolder(Folder)                       'si c'est le premier appel on instruit l'object Folder<<Odir>>avec le string du dossier
    End If

    TakeIT = True                                               'on met la variable Takeit à true d'office
    ' on ouvre une gestion d'erreur globale (pour les permissions refusées ou les noms portants des caracteres speciaux)
    'la gestion est valable aussi pour la boucle subFolder elle est fermé a chaque fin d'appels récursifs
    On Error Resume Next
    If Len(PartName) > 0 Then TakeIT = Len(Dir(oDir.Path & "\" & PartName)) > 0    'si partname demandé on test de presence de (fichier avec PartName dans le nom) dans le dossier en une seule fois
    If recursif = False Then TakeIT = True    ' si pas d'apel récursif on met takeit a true d'office  pour scruter les fichier enfant direct
    If Err.Number <> 0 Or TakeIT = False Then Err.Clear: countdoss = countdoss - 1: GoSub Scanfolder    ' si erreur ou TakeIt =false on zappe l'exploration des fichiers on va directement à l'exploration des sous dossiers avec gosub

    If recursif Then If WithFolder Then NbFichiers = NbFichiers + 1: ReDim Preserve tbl(1 To NbFichiers): tbl(NbFichiers) = oDir.Path

    For Each oFile In oDir.Files            'boucle sur les fichiers
        If Err.Number = 0 Then              'si pas d'erreur
            If Len(PartName) = 0 Then       'si pas de PartName demandé on memorise le fichier directement
                NbFichiers = NbFichiers + 1: ReDim Preserve tbl(1 To NbFichiers): tbl(NbFichiers) = oFile.Path
            Else                            'si PartName demandé on teste si le nom de fichier like PartName
                If oFile.Name Like PartName Then NbFichiers = NbFichiers + 1: ReDim Preserve tbl(1 To NbFichiers): tbl(NbFichiers) = oFile.Path                'Stocke le nom complet du fichier en table
            End If
        End If
        Err.Clear                                       ' on clear l'erreur au cas ou
    Next oFile

Scanfolder:        ' etiquette du jumping d'exploration
    If recursif Then
        For Each oSubDir In oDir.subfolders                 ' boucle sur les dossiers
            ' If recursif = False Then NbFichiers = NbFichiers + 1: ReDim Preserve tbl(1 To NbFichiers): tbl(NbFichiers) = oSubDir.Path
            If Err.Number = 0 Then
                FSO_List_FICHIERS2 oSubDir, PartName, recursif, WithFolder      ' on relance la fonction ( appel récursif)
            Else: Err.Clear                                 ' sinon on clear l'erreur si dossier interdit ou special
            End If
        Next oSubDir
        On Error GoTo 0                                     ' ferme la gestion d'erreur globale
    End If
    ' si c'est le premier appel  donc on a lu tout l'arborescence en appels récursifs on peut maintenant instruire le return de la fonction avec le tableau
    If First_Call Then
        FSO_List_FICHIERS2 = False                      ' on met le return de la fonction a false
        If NbFichiers > 0 Then FSO_List_FICHIERS2 = tbl    ' si NbFichiers est plus grand que 0 le return de la fonction est la tableau
    End If

End Function

 

[MJ13]

Bonjour à tous

Cela me rappelle une de mes veille demande.

VBA Liste Dossiers et sous-dossiers d'un dosssier

Bonjour à tous Je me permet de vous demander une aide pour avoir la liste des dossiers (ou répertoire) et sous-dossiers d'un Dossier. J'ai trouvé des tas de codes mais en général on a le nom des fichiers avec. Le but serait d'avoir le nom des dossiers à trouver en A1 (ex: C:\temp) et...

www.excel-downloads.com

 

[patricktoulon]

Bonjour @MJ13
oui vielle demande
sauf que personne dans cette vielle discussion ne c'est préoccupé de:
1° la lenteur de fso
2° tout du moins de l'utilité de faire ceci ou cela dans la fonction
3° des erreurs 52 et 53 provoquées par des noms de dossier ou fichiers avec caractères particuliers
4° les erreur sur les dossiers ou fichier interdits

d'ailleurs beaucoup jusque là moi y compris l'ont pris comme une fatalité et ont même abandonné pendant un certain temps FSO et ont venté les atout de dir dans une fonction récursives

c'est ce sur quoi nous avons travaillé @Dudu2 et moi
et les résultat ont été surprenants
et pour tout te dire selon le besoins et les conditions, FSO devient plus rapide que dir
et tu peux me croire nous avons testé fso et dir dans les même conditions

 

[MJ13]

Bonjour Patrick

Perso, j'utilise les 2: FSO et Dir. Mais je préfère pour des gros dossiers voire lecteurs la fonction Dir, qui est pour moi plus simple quand on sait manipuler du texte. Avec Dir, je scanne un C:\ de 552 066 fichiers en 120 secondes.

Pour les caractères particuliers, c'est sûr qu'il faut toujours éviter d'en mettre dans les noms de dossiers, que des lettres et des chiffres voir le _ (alt Gr+8).

 

[Roland_M]

Bonjour tout le monde,

@MJ13 , si ça t'intéresse, vois un peu ce petit bijou que j'ai fais,
c'est perso, je mets parfois des rems pour moi parce que je fais régulièrement des modif,
mais ça fais rien, tu me dis ce que tu en pense !?

 

[FRAYM]

Bonjour tout le monde,

@MJ13 , si ça t'intéresse, vois un peu ce petit bijou que j'ai fais,
c'est perso, je mets parfois des rems pour moi parce que je fais régulièrement des modif,
mais ça fais rien, tu me dis ce que tu en pense !?

Bonjour,
Je me sers depuis 2017 d'une version précédente de votre programme, qui m'a été transmise par un collègue. Et, en cherchant, je suis tombé sur votre message.
Je trouve votre programme formidable.
Alors j'en profite pour vous remercier du temps que vous m'avez gagné grâce à votre développement!
Très sincèrement