Fichiers Excel dans dossier et sous-dossier Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
allo3d
Jeune membre
Jeune membre
Messages : 28
Inscrit le : 12 juillet 2018
Version d'Excel : 2016 FR

Message par allo3d » 12 juillet 2018, 14:16

Bonjour à tous,

J'aimerais faire une macro qui lit un répertoire inscrit dans une cellule, puis qu'il affiche le nom de tous les fichiers excel qui s'y trouvent ainsi que leur extension, incluant tous les sous-dossiers qu'il pourrait y avoir dans celui-ci. J'ai fouiller sur plusieurs forums et je n'ai trouer que des réponses spécifiques qui ne m'aident pas vraiment.

Ps: je suis sur vba-excel depuis 3 semaines, alors je me debrouille seulement.

Merci d'avance pour vos réponses.
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 7'788
Appréciations reçues : 211
Inscrit le : 16 juin 2013
Version d'Excel : 2013 UK Windows 10

Message par h2so4 » 12 juillet 2018, 14:33

Bonjour,

par exemple (ne fonctionne pas sur MAC)
Sub listefichierrecursive()
    a = lfr("c:\documents\", "*.*") 'à adapter
    Range("A1").Resize(UBound(a) + 1) = Application.Transpose(a)
End Sub

Function lfr(rep, filtre, Optional ByRef dict, Optional n = 0)
    If IsObject(dict) = False Then Set dict = CreateObject("scripting.dictionary")
    Set fso = CreateObject("scripting.filesystemobject")
    Set rep = fso.getfolder(rep)
    For Each repf In rep.subFolders
        lfr repf, filtre, dict, n + 1
    Next repf
    For Each f In rep.Files
        fn = f.Name
        If f.Name Like filtre Then
            dict.Add f.Path, 0
        End If
    Next f
    If n = 0 Then lfr = dict.keys
End Function
1 membre du forum aime ce message.
Avatar du membre
allo3d
Jeune membre
Jeune membre
Messages : 28
Inscrit le : 12 juillet 2018
Version d'Excel : 2016 FR

Message par allo3d » 12 juillet 2018, 14:42

Merci h2so4,
c'est très prêt du but, je vais fouiller pour essayer de changer un petit peu le code pour qu'il n'affiche que le nom du dossier et non le chemin. :)
Je viens de modifier le filtre pour qu'il n'accepte que les fichiers excel et j'obtiens une erreur de type 13

voici la ligne en question:

a = lfr("C:\Excel\Dossier d'hébergement\", "*.xlsm" Or "*.xls" Or "*.xlsx" Or "*.xlt")
Modifié en dernier par allo3d le 12 juillet 2018, 14:54, modifié 1 fois.
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 7'788
Appréciations reçues : 211
Inscrit le : 16 juin 2013
Version d'Excel : 2013 UK Windows 10

Message par h2so4 » 12 juillet 2018, 14:53

bonjour,

essaie ainsi
a = lfr("C:\Excel\Dossier d'hébergement\", "*.xl*" )
Avatar du membre
allo3d
Jeune membre
Jeune membre
Messages : 28
Inscrit le : 12 juillet 2018
Version d'Excel : 2016 FR

Message par allo3d » 12 juillet 2018, 15:00

Merci encore une fois h2so4,

Lorsque je touche à :

If f.Name Like filtre Then
dict.Add f.Path, 0
End If

ceci m'indique erreur 13
Range("A3").Resize(UBound(a) + 1) = Application.Transpose(a)

je n'ai pourtant voulu qu'enlever le f.path

Merci d'avance
Modifié en dernier par allo3d le 12 juillet 2018, 15:05, modifié 1 fois.
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 7'788
Appréciations reçues : 211
Inscrit le : 16 juin 2013
Version d'Excel : 2013 UK Windows 10

Message par h2so4 » 12 juillet 2018, 15:04

bonjour,


pour répondre à ta question, mets le code que tu as adapté.

sinon, pour n'avoir que le nom des classeurs (sans doublons) et non le chemin complet
Sub listefichierrecursive()
    a = lfr("c:\documents\", "*.xl*") 'à adapter
    Range("A1").Resize(UBound(a) + 1) = Application.Transpose(a)
End Sub

Function lfr(rep, filtre, Optional ByRef dict, Optional n = 0)
    If IsObject(dict) = False Then Set dict = CreateObject("scripting.dictionary")
    Set fso = CreateObject("scripting.filesystemobject")
    Set rep = fso.getfolder(rep)
    For Each repf In rep.subFolders
        lfr repf, filtre, dict, n + 1
    Next repf
    For Each f In rep.Files
        fn = f.Name
        If f.Name Like filtre Then
            dict(f.Name) = 0
        End If
    Next f
    If n = 0 Then lfr = dict.keys
End Function
Avatar du membre
allo3d
Jeune membre
Jeune membre
Messages : 28
Inscrit le : 12 juillet 2018
Version d'Excel : 2016 FR

Message par allo3d » 12 juillet 2018, 15:09

Merci beaucoup h2so4, c'est ce qu'il me fallait!
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message