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

[ALAIN-KLAIKENS]

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

 

[patricktoulon]

bonsoir
une formule non un script vba oui
mais il faudrait peut être un peu argumenter ta demande
y a t il des sous dossiers?
tu veux la liste sous quelle forme?
tout type de fichier ou un type en particulier ?

 

[ALAIN-KLAIKENS]

Bonjour patricktoulon
Un script vba me conviendrais
pour la forme dans une feuille excel inscrire le nom du fichier ou du dossier et sous dossier
tout type de fichier
et inclure les sous dossier
j'espère que tu voie mieux mon souhait
Merci à toi

 

[JHA]

Bonjour à tous,

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

Microsoft 365 - Formule pour lister fichier

Bonsoir à tous Voilà je voudrais trouver une formule qui pourrais écrire dans une feuille excel tout les dossiers et sous dossier avec tout les fichiers qui ce trouvent dedans affin de voir sur une seul feuille le contenu d'un dossier. Si l'un d'entre vous pouvais me la donnez j'en serais...

www.excel-downloads.com

JHA

 

[Dranreb]

Bonjour.

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

 

[mapomme]

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.

 

[patricktoulon]

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

'***************************************************
'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

 

[ALAIN-KLAIKENS]

Bonjour.

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]

Bonsoir Dranreb,

Merci de prendre du temps pour moi, j'ai bien activez la référence Microsoft Scripting Runtime dans référence dans visual basic mais malheureusement quand je lance la macro, j'ai un cadre qui s'affiche avec :
Argument ou appel de procédure incorecte

 

[Dranreb]

Sur quelle instruction ?
Avez vous renseigné en A1 de la feuille active le dossier racine à analyser ?

 

[ALAIN-KLAIKENS]

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

'***************************************************
'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

 

[ALAIN-KLAIKENS]

Bonsoir patricktoulon

quand je lance ta macro j'ai une erreur 400

Sur quelle instruction ?
Avez vous renseigné en A1 de la feuille active le dossier racine à analyser ?

au moment ou je lance la macro

 

[Dranreb]

Ce que je vous demandais c'est sur quelle instruction, pas à quel moment.

 

[ALAIN-KLAIKENS]

Désolé la je suis pas tout ce que je fait et que je cherche c'est lancer ta macro a l'aide d'un bouton sur ma feuille

 

[Dranreb]

Alors je ne peux pas vous aider, si vous ne me dites pas quelle instruction plante quand vous allez en débogage.
Tout ce que je peux vous dire c'est que ça marche chez moi avec un dossier existant précisé en A1.