XL 2013 Récupérer les fichiers d'un dossier et de ses sous-dossiers tous niveaux

[Dudu2]

Bonjour les Excellents,
Je cherche une séquence de code VBA permettant de faire ce que dit le titre du sujet.
Je n'ai pas ça dans mes cartons et si vous l'aviez cela me ferait gagner du temps de codage.
Cordialement
D.

 

[Dudu2]

J'ai ça https://www.excel-downloads.com/threads/vba-liste-dossiers-et-sous-dossiers-dun-dosssier.126930/
Mais ça ne donne que les dossiers et pas les fichiers.
Ok, faut aller chercher les fichiers, je devrais y arriver. Mais proposez, on ne sait jamais, il y a toujours des idées à retenir.

 

[Staple1600]

Bonjour le fil, Dudu2

•>Dudu2
Maintenant que tu as posé la question, il suffit de tourner la tête vers la droite de l'écran

Récupérer le chemin des fichiers de tous les dossiers et sous dossiers du répertoire

Bonjour à tous, le Forum, Je cherche a récupérer l'ensemble des chemins de tous les fichiers d'un répertoire qui comporte des dossiers, sous dossiers voires sous sous dossiers. Je bien trouver des exemples mais ceux-ci, et sauf erreur de ma part, ne me récupère que les fichiers du...

www.excel-downloads.com

 

[Dudu2]

Merci Staple1600,

Au final un code résultant de ces infos utiles.

Option Explicit

'----------------------
'Saisie d'un répertoire
'----------------------
Sub SaisieRépertoire()
    Dim Répertoire As String
    Dim Réponse As Variant
    '_______________________
    'A partir de "Office XP"
    If Val(Application.Version) >= 10 Then
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = ActiveWorkbook.Path & "\"
            .Show
            If .SelectedItems.Count > 0 Then
                Répertoire = .SelectedItems(1)
            Else
                Répertoire = ""
            End If
        End With
    '_________________
    'Avant "Office XP"
    Else
        Réponse = Application.InputBox("Répertoire ?", Default:=ActiveWorkbook.Path & "\", Type:=2)
        If VarType(Réponse) = vbBoolean Then Exit Sub
        Répertoire = Réponse
    End If
  
    'Répertoire incorrect
    If Len(Répertoire) = 0 Or Len(Dir(Répertoire, vbDirectory)) = 0 Then Exit Sub
  
    Call ParcoursRépertoire(Répertoire)
End Sub

'------------------------
'Parcours d'un répertoire
'------------------------
Sub ParcoursRépertoire(Répertoire As String)
    Dim oFSO As Object
    Dim oDir As Object
  
    'File System Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
  
    Set oDir = oFSO.getfolder(Répertoire)
    Call ParcoursFichiersEtSousRépertoires(oDir)
End Sub

'-----------------------------------------
'Parcours des fichiers et sous-répertoires
'-----------------------------------------
Sub ParcoursFichiersEtSousRépertoires(oDir As Object)
    Dim oSubDir As Object
    Dim oFile As Object
  
    'MsgBox oDir.Path
  
    'Parcours des fichiers du [sous-]répertoire
    For Each oFile In oDir.Files
        Call TraiteFichier(oFile.Path)
    Next oFile
  
    'Parcours des sous-répertoires du [sous-]répertoire
    For Each oSubDir In oDir.SubFolders
      Call ParcoursSousRépertoires(oSubDir)
    Next oSubDir
End Sub

'-----------------------
'Traitement d'un fichier
'-----------------------
Sub TraiteFichier(Fichier As String)
    MsgBox "Traitement <" & Fichier & ">"
End Sub