Forum de discussion

Macro VBA parcourir dossier et sous dossier

internet
#1

Bonjour,

J’ai réalisé un macro VBA qui consiste à aller ouvrir dans un repertoire tous les fichiers excel possèdant la feuille “SQL” et copier le contenu dans un fichier texte au même endroit et sous le même nom que le fichier d’origine.

Cependant ma macro ne va pas chercher les fichiers situés dans les sous dossiers.

Quelqu’un pourrai m’aider le code est le suivant :

`Sub Trans_Fichier_Texte()
'|||||||||||||||||||||||||||||||Partie Déclarations des variables|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

Dim Boite_dialogue As FileDialog 'variable BDD (Boîte de Dialogue Dossier)
Dim Chemin_Dossier As String 'variable chemin_Dossier (Chemin d’Accès)
Dim Repertoire As Workbook 'variable repertoire
Dim Fichier_parcouru As String 'variable Fichier selectionne correspond au fichier définit par (Fichier Source)
Dim Classeur As Workbook 'variable CS (Classeur Source)
Dim start As Single
Dim Chemin_Fichier As String
Dim Feuille As String
Dim F As Integer
Dim Nom_Fichier As String
Dim Nom_Fichier_MAJ As String
Dim FSO As Object

'|||||||||||||||||||||||||||||||Partie Choix du repertoire||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

MsgBox " Vous allez choisir le répetoire d’exécution ", vbOKOnly + vbInformation, “Faîtes le bon choix”

'définit la boîte de dialogue BDD (permetant de définir le dossier des fichiers source)

Set Boite_dialogue = Application.FileDialog(msoFileDialogFolderPicker)

With Boite_dialogue 'prend en compte BDD
.AllowMultiSelect = True 'n’autorise qu’une seule sélection
.Show 'affiche Boite de dialogue
If .SelectedItems.Count = 0 Then Exit Sub 'si bouton [Annuler], sort de la procédure
Chemin_Dossier = .SelectedItems(1) & “” 'définit le chemin d’accès chemin aux fichiers à ouvrir
End With 'fin de la prise en compte de la boite de dialogue
Set Repertoire = ThisWorkbook 'définit la classeur destination CD
Fichier_parcouru = Dir(Chemin_Dossier & “.x”) 'définit le premier fichier source Excel contenu dans le dossier ayant comme chemin d’accès

'|||||||||||||||||||||||||||||||Partie transformation fichier excel en fichier texte||||||||||||||||||||||||||||||||||||||
start = Timer
'desactive le rafraichissmeent de l’ecran et accelère le processus
Application.ScreenUpdating = False

'Boucle Do while permettant de parcourir les fichiers un par un et de lui appliquer la macro Fichier_MAJ tant qu’il trouvera un fichier source dans le repertoire
Do While Fichier_parcouru <> “”
Workbooks.Open Chemin_Dossier & Fichier_parcouru 'Selectionne le fichier source
Set Classeur = ActiveWorkbook 'définit le classeur parcouru

If Verif_feuille("SQL") Then
    
        'C'est le chemin complet du fichier à ouvrir.
        Chemin_Fichier = ActiveWorkbook.Path
        'Attribution du nom du fichier ouvert à Fichier_name
        Nom_Fichier = ActiveWorkbook.Name
        'Nom du fichier sans l'extenction
        ext = InStr(StrReverse(Nom_Fichier), ".")
        Nom_Fichier_MAJ = Left(Nom_Fichier, Len(Nom_Fichier) - ext)
    
        'La macro active la feuille nommée "SQL
        Feuille = ActiveWorkbook.Worksheets("SQL").Activate
    
        'FreeFile permet de fournir un numéro de fichier qui n’est pas déjà en cours d’utilisation.
        F = FreeFile
    
        ' On créé un fichier texte avec le même nom que le fichier excel
        Open Chemin_Fichier & "\" & Nom_Fichier_MAJ & ".txt" For Output As #F 'Output : écriture avec effacement du fichier à chaque ouverture.
    
        ' boucle For Next pour parcourir les cellules de la feuille active et les stocker dans le fichier texte
        For i = 1 To 2

            Print #F, Cells(i, 1)
        
        Next

            Close #F

    
        Classeur.Close False 'ferme le classeur (sans enregistrer)
        Fichier_parcouru = Dir 'définit le prochain fichier source excel du dossier ayant comme chemin d'accès
    
Else
    
    Classeur.Close False 'ferme le classeur parcouru (sans enregistrer)
    Fichier_parcouru = Dir 'définit le prochain fichier source excel du dossier ayant comme chemin d'accès

End If

Loop

'|||||||||||||||||||||||||||||||Partie Annonce du résultat||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
MsgBox "Les codes SQL ont bien été copiés dans des fichiers texte ! ", vbOKOnly + vbInformation, “Informations”
MsgBox “durée du traitement: " & Timer - start & " secondes”
End Sub
'|||||||||||||||||||||||||||||||Partie Fonction ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

Function Verif_feuille(NomF As String) As Boolean ’ test si la feuille existe
On Error Resume Next 'permet d’ignorer les erreurs de la procédure
Verif_feuille = Not Sheets(NomF) Is Nothing
End Function

Cordialement,

0 Likes

#2

bonjour
a priori en regardant l’exemple 8 de https://www.exceltrick.com/formulas_macros/vba-dir-function/ il faut faire 2 boucles
une première récupère les répertoires et les stockent dans un tableau avec dir associé a l’attribut vbDirectory pour avoir les répertoires
la deuxième utilise le contenu du tableau pour faire tous les répertoires à la recherche de fichier

1 Like

#3

Bonjour,

J’ai pas réussi à appliquer le code au mien.
Cependant, j’ai réussi à parcourir les sous dossiers du répertoire mais lorsque des sous dossiers sont présents dans un autre sous dossier la macro ne va pas jusque là.

Quelqu’un peut m’aider ?
Sub Trans_Fichier_Texte()
'|||||||||||||||||||||||||||||||Partie Déclarations des variables|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

Dim Boite_dialogue As FileDialog 'variable BDD (Boîte de Dialogue Dossier)
Dim Chemin_Dossier As String 'variable chemin_Dossier (Chemin d’Accès)
Dim Repertoire As Workbook 'variable repertoire
Dim Fichier_parcouru As String 'variable Fichier selectionne correspond au fichier définit par (Fichier Source)
Dim Classeur As Workbook 'variable CS (Classeur Source)
Dim start As Single
Dim Chemin_Fichier As String
Dim Feuille As String
Dim F As Integer
Dim Nom_Fichier As String
Dim Nom_Fichier_MAJ As String
Dim Chemin1 As String
Dim CHEMIN, FICHIER As String
Dim WB, I As Workbook
Dim NBWB As Byte
Dim fso, ListR, sRep, ListF, Rep, LesReps, fich, LesFichs

Chemin_Dossier = InputBox("Saisir le chemin : ")
Chemin_Dossier = Chemin_Dossier & “”
Fichier_parcouru = Dir(Chemin_Dossier & “.x”)

Do While Fichier_parcouru <> “”
Workbooks.Open Chemin_Dossier & Fichier_parcouru 'Selectionne le fichier source
Set Classeur = ActiveWorkbook 'définit le classeur parcouru

If Verif_feuille("SQL") Then
    
        'C'est le chemin complet du fichier à ouvrir.
        Chemin_Fichier = ActiveWorkbook.Path
        'Attribution du nom du fichier ouvert à Fichier_name
        Nom_Fichier = ActiveWorkbook.Name
        'Nom du fichier sans l'extenction
        ext = InStr(StrReverse(Nom_Fichier), ".")
        Nom_Fichier_MAJ = Left(Nom_Fichier, Len(Nom_Fichier) - ext)
    
        'La macro active la feuille nommée "SQL
        Feuille = ActiveWorkbook.Worksheets("SQL").Activate
    
        'FreeFile permet de fournir un numéro de fichier qui n’est pas déjà en cours d’utilisation.
        F = FreeFile
    
        ' On créé un fichier texte avec le même nom que le fichier excel
        Open Chemin_Fichier & "\" & Nom_Fichier_MAJ & ".txt" For Output As #F 'Output : écriture avec effacement du fichier à chaque ouverture.
    
        ' boucle For Next pour parcourir les cellules de la feuille active et les stocker dans le fichier texte
        For j = 1 To 2

            Print #F, Cells(j, 1)
        
        Next

            Close #F

    
        Classeur.Close False 'ferme le classeur (sans enregistrer)
        Fichier_parcouru = Dir 'définit le prochain fichier source excel du dossier ayant comme chemin d'accès
    
Else
    
    Classeur.Close False 'ferme le classeur parcouru (sans enregistrer)
    Fichier_parcouru = Dir 'définit le prochain fichier source excel du dossier ayant comme chemin d'accès

End If

Loop
Set fso = CreateObject(“Scripting.FileSystemObject”)

’ Initialisation des variables
Set ListR = fso.GetFolder(Chemin_Dossier)
Set sRep = ListR.SubFolders

’ Parcours des sous dossiers
For Each Rep In sRep

'LesReps = LesReps & Rep.Name
'LesReps = LesReps & vbCrLf

Set ListF = Rep.Files

’ Parcours des fichiers de chaque sous dossier
For Each fich In ListF

' Controle si le fichier est un fichier Excel (xlsx)
    If fich.Name Like "*.x*" Then
        CHEMIN = Chemin_Dossier & "\" & Rep.Name & "\"
        'MsgBox CHEMIN
        FICHIER = Dir(CHEMIN & fich.Name)
        'Set WB = Workbooks.Open(CHEMIN & FICHIER)
    End If

Do While FICHIER <> “”
Workbooks.Open CHEMIN & FICHIER 'Selectionne le fichier source
Set Classeur = ActiveWorkbook 'définit le classeur parcouru

If Verif_feuille("SQL") Then
    
        'C'est le chemin complet du fichier à ouvrir.
        CHEMIN = ActiveWorkbook.Path
        'Attribution du nom du fichier ouvert à Fichier_name
        Nom_Fichier = ActiveWorkbook.Name
        'Nom du fichier sans l'extenction
        ext = InStr(StrReverse(Nom_Fichier), ".")
        Nom_Fichier_MAJ = Left(Nom_Fichier, Len(Nom_Fichier) - ext)
    
        'La macro active la feuille nommée "SQL
        Feuille = ActiveWorkbook.Worksheets("SQL").Activate
    
        'FreeFile permet de fournir un numéro de fichier qui n’est pas déjà en cours d’utilisation.
        F = FreeFile
    
        ' On créé un fichier texte avec le même nom que le fichier excel
        Open CHEMIN & "\" & Nom_Fichier_MAJ & ".txt" For Output As #F 'Output : écriture avec effacement du fichier à chaque ouverture.
    
        ' boucle For Next pour parcourir les cellules de la feuille active et les stocker dans le fichier texte
        For j = 1 To 2

            Print #F, Cells(j, 1)
        
        Next

            Close #F

    
        Classeur.Close False 'ferme le classeur (sans enregistrer)
        FICHIER = Dir 'définit le prochain fichier source excel du dossier ayant comme chemin d'accès
    
Else
    
    Classeur.Close False 'ferme le classeur parcouru (sans enregistrer)
    FICHIER = Dir 'définit le prochain fichier source excel du dossier ayant comme chemin d'accès

End If

Loop
’ Reinitialisation des variables
CHEMIN = “”
FICHIER = “”
'LesFichs = LesFichs & fich.Name
'LesFichs = LesFichs & vbCrLf
Next
Next

'|||||||||||||||||||||||||||||||Partie Annonce du résultat||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
MsgBox "Les codes SQL ont bien été copiés dans des fichiers texte ! ", vbOKOnly + vbInformation, “Informations”
MsgBox “durée du traitement: " & Timer - start & " secondes”
End Sub
'|||||||||||||||||||||||||||||||Partie Fonction ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

Function Verif_feuille(NomF As String) As Boolean ’ test si la feuille existe
On Error Resume Next 'permet d’ignorer les erreurs de la procédure
Verif_feuille = Not Sheets(NomF) Is Nothing
End Function

0 Likes

#4

j’ai fait un poil de Visual basic il y a 10ans mais sans plus et jamais dans la suite office (et pas ce type de code orienté répertoire)

si cela te donne que la première couche de répertoire et pas les répertoire dans les répertoire c’est qu’il faut faire encore une boucle pour chaque répertoire , une boucle récursive jusqu’à atteindre le fond des répertoires

en gros la fonction de recherche de repertoire/fichier doit être appeler a nouveau jusqu’à atteindre le bout et remplir un contenant au fur et a mesure

c’est ce qu’il fait dans l’exemple Traversing directory là :
https://analystcave.com/vba-dir-function-how-to-traverse-directories/
il utilise un stockage “VBA collection” qui semble tailler pour stocker ce type de liste

au premier passage la fonction liste la premiere couche de répertoire et la stocke dans dirCollection
le code

For Each directory In dirCollection
TraversePath path & directory & “”
Next directory

fait la récursivité de la fonction, elle s’appelle elle même jusqu’au bout en utilisant le dernier passage dans la fonction comme base pour le passage suivant

bon je ne sais pas comment marche les variables sur VBA mais la plupart du temps un truc declaré dans une fonction est local à la fonction donc dirCollection faudra peut être le rendre plus global (à l’extérieur de la fonction) pour l’utiliser dans ta gestion des fichiers.

comme c’est fait dans la réponse (plus ancienne) de Crenaud76 la : https://codes-sources.commentcamarche.net/forum/affich-565187-un-equivalent-du-dir-s-de-dos-vb
(la c’est listdir qui s’apelle elle même, et tout est stocké dans un tableau de string F (à l’ancienne qu’il faut agrandir a chaque boucle, la “Vba collection” simplifie la gestion des données dans un tableau (tuto vba collection : https://analystcave.com/vba-collection/ ))

0 Likes

#5

Toutafé :wink:

En VBA si tu déclares une variable dans une procédure, elle a une porté restreinte à ladite procédure.
Si la variable est déclarée en début de module, alors sa portée s’entend sur toutes les procédures dudit module.
On peut aussi déclarer des variables globales ayant une portée sur tout le projet.

0 Likes

#6

Bonjour,

Merci pour les informations, mais j’arrive toujours pas à appliquer le bon code pour que mon code parcours outs les niveaux de dossiers…

0 Likes

#7

j’ai fait qq essais
comme prévu c’est le passage du local au global qui m’a posé probleme
j’ai fini par faire intervenir une “collection” de stockage global car toucher au code de la fonction me posait des problèmes
La macro1 fait scanner un répertoire et remplit listecomplete avec tous les répertoires et tous les fichiers (dans d:\essai)
La macro2 : je récupère dans listecomplete que les “.txt” que j’affiche dans les cellules excel

Dim Listecomplete As Collection

Sub TraversePath(path As String, liste As Collection)
Dim currentPath As String, directory As Variant
Dim dirCollection As Collection
Set dirCollection = New Collection

currentPath = Dir(path, vbDirectory)

'Explore current directory
Do Until currentPath = vbNullString
    Debug.Print currentPath
    If Left(currentPath, 1) <> "." And _
        (GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then
        dirCollection.Add currentPath
        
    End If
    If Left(currentPath, 1) <> "." Then
        liste.Add path & currentPath
    End If
    currentPath = Dir()
    
Loop

'Explore subsequent directories
For Each directory In dirCollection
     
    Debug.Print "---SubDirectory: " & directory & "---"
    TraversePath path & directory & "\", liste
    
Next directory

End Sub

Sub Macro1()

Set Listecomplete = New Collection
TraversePath "d:\essai\", Listecomplete
Debug.Print "ok"
Cells(1, 1).Value = "ok"

End Sub

Sub Macro2()
Debug.Print “debut”
Dim x As Integer
x = 1
For Each Item In Listecomplete
Debug.Print x
Debug.Print "—Macro2item: " & Item & “—”
If Right(Item, 4) = “.txt” Then
Cells(x, 1).Value = Item
x = x + 1
End If
Next Item
End Sub

Attention s’il y a vraiment beaucoup de fichier/repertoire cela risque de cracher dans la macro1 (surement car cela remplit trop les Collection), faire un trie au moment de la remplir plutôt que lors de l’affichage/traitement

J’ai essayé avec mon répertoire steam, cela n’a pas du tout aimé (plus de 200 000 fichiers et 9400repertoire : cela ne passe pas du tout :rofl: je ne connais pas la limite)

1 Like

#8

Les capacités d’Excel dépendent de la version (16 ou 32 bits, entre autres). :wink:

200 000 fichiers, avec un integer, ça va pas l’faire… :wink:

De plus, il me semble avoir lu il y a quelques années, que travailler sur des integer était plus chronophage que travailler sur des long.

En tout cas, c’est sympa d’avoir cherché si assidûment une solution ! :+1:

0 Likes

#9

j’ai essayé de mettre des == dans un if et un x+=1 :sweat_smile:
une dizaine de minute a chercher comment faire du VBA (une activation mode développeur en - de 5 clics :smile: ), pareil pour mettre un truc dans une case d’excel, pareil pour gestion des macros/case cliquable… mais bon cela servira peut être un jour cela

C’est surement loin d’être parfait (pas de garde fou surtout, peut être un code noté “niveau bricolage” au niveau de ma collection ajouté dans le code copié de la TraversePath originel, un truc plus propre existe probablement) mais cela montre qu’il faut :
– en passer par une fonction dédiée qui peut être appeler a nouveau pour chacun des répertoires existants
je ferai au moins 2 fonctions pour faire ton programme, 1 d’action “lecture des fichiers et concaténation”, une de “listing des fichier a traiter” qui sera faite en boucle qui explore les répertoires
– que quand on a un probleme il faut utiliser des outils/marqueurs pour comprendre ce qu’il se passe, ici les Debug.Print sont super pratique pour cela avec la fenêtre execution, on voit que cela passe bien dans chaque répertoire “essai”, c’est grâce a cela que j’ai vu que je donnais une Collection vide chaque fois à ma macro2

en tout cas, je n’aime pas le fonctionnement de ce “dir”

un exemple avec + de répertoire, fichiers
ta partie "If Verif_feuille(“SQL”) Then " elle irait pour moi dans le for each item tout en bas avec par exemple Item remplacé par ton “Fichier_parcouru”

1 Like