Microsoft 365 lister les nom de tout les fichiers et des dossier

ALAIN-KLAIKENS

XLDnaute Nouveau
Bonsoir à tous
Voilà je voudrais trouver une formule pour lister les nom de tout les fichiers et des dossier contenu dans un dossier et dans les sous dossier de celui ci
Merci à vous
 

JHA

XLDnaute Barbatruc
Bonjour à tous,

Tu as eu des réponses là, il faut éviter de multiplier les postes pour la même demande.


JHA
 

Dranreb

XLDnaute Barbatruc
Bonjour.
VB:
Option Explicit
Private TRés(), LCou As Long, FSO As New FileSystemObject
Sub ListeFic()
   ReDim TRés(1 To 10000, 1 To 2)
   LCou = 0
   Lister FSO.GetFolder(ActiveSheet.Cells(1, "A").Value)
   ActiveSheet.Rows(3).Resize(10000).Delete
   ActiveSheet.[A3].Resize(LCou, 2).Value = TRés
   Erase TRés
   End Sub
Private Sub Lister(ByVal Fdr As Scripting.Folder)
   Dim ChemDoss As String, FdrS As Scripting.Folder, Fle As Scripting.File
   ChemDoss = Fdr.Path
   On Error Resume Next
   For Each Fle In Fdr.Files
      If Fle Is Nothing Then Exit For
      LCou = LCou + 1
      TRés(LCou, 1) = ChemDoss
      TRés(LCou, 2) = Fle.Name
      Next Fle
   For Each FdrS In Fdr.SubFolders
      If FdrS Is Nothing Then Exit Sub
      Lister FdrS: Next FdrS
   End Sub
Activez la référence Microsoft Scripting Runtime
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @ALAIN-KLAIKENS, @patricktoulon ;), @JHA ;), @Dranreb ;),

Une autre version. Indiquer le répertoire à lister dans la cellule D2. Puis cliquer sur le le bouton Hop!.

Je n'ai pas compris, à la lecture du premier message, qu'il fallait aussi lister les fichiers des sous-répertoires récursivement donc je ne l'ai pas fait.
 

Pièces jointes

  • ALAIN-KLAIKENS- fichiers et dossiers- v1.xlsm
    22.9 KB · Affichages: 44
Dernière édition:

patricktoulon

XLDnaute Barbatruc
Bosoir @ALAIN-KLAIKENS, , @JHA, @Dranreb ,@mapomme

et oui rendre dir (qui est le plus rapide en vb pour lister fichier et dossier) est difficile a rendre récursif (ne l’étant pas en natif)
je te met au défit cependant de trouver plus rapide que celle ci
chez moi scriptingfilesystemobject n'en fini plus
les commandes (tree ,etc...) executée avec shell sont trop complexes a mettre en place avec la disparité des versions windows et excel
je viens de tester encore celle fonctionne toujours a merveille
VB:
'***************************************************
'lister dossier et sub dossiers et fichier
'fonction récursive avec DIR
'patricktoulon su Developpez.com
'version 1.2A
'date version:15/04/2017
'***************************************************
Sub testXy()
    Cells.Clear
    Dim liste As Variant
    liste = DirList("H:\")
    Cells(1, 1).Resize(UBound(liste), 1).Value = Application.Transpose(liste)
End Sub

Function DirList(Dossier As String, Optional recall As Boolean = False, Optional tbl As Variant) As Variant
    Dim ItemVu As String, directory As Variant, SubFolderCollection As Collection, I As Long, A As Long, E As Long
    Set SubFolderCollection = New Collection
    If recall = False Then ReDim tbl(0)    ' si recall  on redim un tableau  de zero item (pour la creation du tableau)
    On Error Resume Next    'gestion des fichiers dossiers system et interdit ou générant une erreur(PerLog,recycle,etc..)
    ItemVu = Dir(Dossier, vbDirectory)
    If Error.Number = 0 Then    ' si pas d'erreur on examine le contenu
        'examen  du dossier courrant
        Do Until ItemVu = vbNullString
            If Left(ItemVu, 1) <> "." Then
                If (GetAttr(Dossier & ItemVu) And vbDirectory) = vbDirectory Then
                    SubFolderCollection.Add ItemVu
                Else
                    A = UBound(tbl) + 1: ReDim Preserve tbl(1 To A): tbl(A) = Dossier & ItemVu
                End If
            End If
            ItemVu = Dir()
        Loop
    Else
        Err.Clear
    End If
    'examen des sub dossier
    For Each subdossier In SubFolderCollection
        A = UBound(tbl) + 1: ReDim Preserve tbl(1 To A): tbl(A) = Dossier & subdossier
        DirList Dossier & subdossier & "\", True, tbl
    Next subdossier
    DirList = tbl
End Function
 
Dernière édition:

ALAIN-KLAIKENS

XLDnaute Nouveau
Bonjour.
VB:
Option Explicit
Private TRés(), LCou As Long, FSO As New FileSystemObject
Sub ListeFic()
   ReDim TRés(1 To 10000, 1 To 2)
   LCou = 0
   Lister FSO.GetFolder(ActiveSheet.Cells(1, "A").Value)
   ActiveSheet.Rows(3).Resize(10000).Delete
   ActiveSheet.[A3].Resize(LCou, 2).Value = TRés
   Erase TRés
   End Sub
Private Sub Lister(ByVal Fdr As Scripting.Folder)
   Dim ChemDoss As String, FdrS As Scripting.Folder, Fle As Scripting.File
   ChemDoss = Fdr.Path
   On Error Resume Next
   For Each Fle In Fdr.Files
      If Fle Is Nothing Then Exit For
      LCou = LCou + 1
      TRés(LCou, 1) = ChemDoss
      TRés(LCou, 2) = Fle.Name
      Next Fle
   For Each FdrS In Fdr.SubFolders
      If FdrS Is Nothing Then Exit Sub
      Lister FdrS: Next FdrS
   End Sub
Activez la référence Microsoft Scripting Runtime
 

ALAIN-KLAIKENS

XLDnaute Nouveau
Bosoir @ALAIN-KLAIKENS, , @JHA, @Dranreb ,@mapomme

et oui rendre dir (qui est le plus rapide en vb pour lister fichier et dossier) est difficile a rendre récursif (ne l’étant pas en natif)
je te met au défit cependant de trouver plus rapide que celle ci
chez moi scriptingfilesystemobject n'en fini plus
les commandes (tree ,etc...) executée avec shell sont trop complexes a mettre en place avec la disparité des versions windows et excel
je viens de tester encore celle fonctionne toujours a merveille
VB:
'***************************************************
'lister dossier et sub dossiers et fichier
'fonction récursive avec DIR
'patricktoulon su Developpez.com
'version 1.2A
'date version:15/04/2017
'***************************************************
Sub testXy()
    Cells.Clear
    Dim liste As Variant
    liste = DirList("H:\")
    Cells(1, 1).Resize(UBound(liste), 1).Value = Application.Transpose(liste)
End Sub

Function DirList(Dossier As String, Optional recall As Boolean = False, Optional tbl As Variant) As Variant
    Dim ItemVu As String, directory As Variant, SubFolderCollection As Collection, I As Long, A As Long, E As Long
    Set SubFolderCollection = New Collection
    If recall = False Then ReDim tbl(0)    ' si recall  on redim un tableau  de zero item (pour la creation du tableau)
    On Error Resume Next    'gestion des fichiers dossiers system et interdit ou générant une erreur(PerLog,recycle,etc..)
    ItemVu = Dir(Dossier, vbDirectory)
    If Error.Number = 0 Then    ' si pas d'erreur on examine le contenu
        'examen  du dossier courrant
        Do Until ItemVu = vbNullString
            If Left(ItemVu, 1) <> "." Then
                If (GetAttr(Dossier & ItemVu) And vbDirectory) = vbDirectory Then
                    SubFolderCollection.Add ItemVu
                Else
                    A = UBound(tbl) + 1: ReDim Preserve tbl(1 To A): tbl(A) = Dossier & ItemVu
                End If
            End If
            ItemVu = Dir()
        Loop
    Else
        Err.Clear
    End If
    'examen des sub dossier
    For Each subdossier In SubFolderCollection
        A = UBound(tbl) + 1: ReDim Preserve tbl(1 To A): tbl(A) = Dossier & subdossier
        DirList Dossier & subdossier & "\", True, tbl
    Next subdossier
    DirList = tbl
End Function
 

Discussions similaires

Réponses
5
Affichages
113

Statistiques des forums

Discussions
311 715
Messages
2 081 822
Membres
101 821
dernier inscrit
hybroxis