Macro sur fichiers dans dossiers séparés [Résolu/Fermé]

Signaler
Messages postés
38
Date d'inscription
jeudi 10 janvier 2013
Statut
Membre
Dernière intervention
5 avril 2018
-
Messages postés
38
Date d'inscription
jeudi 10 janvier 2013
Statut
Membre
Dernière intervention
5 avril 2018
-
Bonjour,

j'ai une liste de ~1000 dossiers comprenant tous (entre autres) un fichier 'information.xlsx'. Voir ici un exemple de 5 dossiers :



A partir du fichier test.xlsx repris dans le répertoire, je dois lister le nom de chacun de ces dossiers et pour chacun d'eux aller récupérer des données reprises dans chaque fichier information.xlsx. Je parviens à faire ces deux étapes de façon indépendante mais je n'arrive pas à les combiner.

Pour l'heure, je récupère les noms de dossiers avec cette macro :

Sub PrintFolders()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer

Application.StatusBar = ""
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Users\Macro_test")
i = 1
'loops through each folder in the directory and prints their names and path
For Each objSubFolder In objFolder.subfolders
Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
    'print folder name
    Cells(i + 1, 1) = objSubFolder.Name
    i = i + 1
    
Next objSubFolder
End Sub


Auriez-vous quelques piste sur comment améliorer la macro ci-dessus pour ouvrir chacun de ces dossiers et appliquer une quelconque opération sur le fichier information.xlsx ?

Je crois devoir utiliser la méthode Workbooks.Open(Path & "information.xlsx") en faisant référence à objSubFolder.Path mais je ne parviens pas à le faire.

Auriez-vous quelques indications ? Merci d'avance !!

CL




EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.

1 réponse

Messages postés
16432
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
24 juillet 2021
880
bonsoir, peut-être:
dim wb as workbook
set wb = Workbooks.Open(objSubFolder.Path & "\information.xlsx") 
Messages postés
38
Date d'inscription
jeudi 10 janvier 2013
Statut
Membre
Dernière intervention
5 avril 2018

Merci encore pour votre aide !

Voici à quoi j'arrive :

 Sub PrintFolders()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer

Dim Wb As Workbook
Dim strFile As String
Dim strDir As String

Dim fdest As Worksheet, fsource As Worksheet
Dim dlig As Long
Dim sfich As String
Dim srow As Range
Dim crit1$, crit2$, crit3$
Dim skey, sval, cpath As String

cpath = ThisWorkbook.Path & "\"
Set fdest = ActiveSheet
crit1 = fdest.Cells(1, 2)
crit2 = fdest.Cells(1, 3)
crit3 = fdest.Cells(1, 4)

dlig = 2

Application.StatusBar = ""
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Users\Macro_test\")
i = 1
'loops through each folder in the directory and prints their names and path
For Each objSubFolder In objFolder.subfolders
Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
'print folder name
strDir = objSubFolder.Path
strFile = strDir & "\informations.txt"
'Loop

Do While strFile <> ""
Set Wb = Workbooks.Open(strFile, Format:=6, Delimiter:=",")
'Save it as Excel file, same name as text file
Wb.SaveAs Left(strFile, InStrRev(strFile, ".") - 1), xlWorkbookDefault
'Done
Wb.Close
Set Wb = Nothing
Set Wb = Workbooks.Open(strDir & "\informations.xlsx")
Set fsource = Wb.Sheets(1)
For Each srow In fsource.UsedRange.Rows
skey = srow.Cells(1, 1)
sval = srow.Cells(1, 2)
Select Case skey
Case Is = crit1
fdest.Cells(dlig, 2) = sval
Case Is = crit2
fdest.Cells(dlig, 3) = sval
Case Is = crit3
fdest.Cells(dlig, 4) = sval
End Select
Next srow
Wb.Close
dlig = dlig + 1
sfich = fdest.Cells(dlig, 1)
Exit Do
Loop

Cells(i + 1, 1) = objSubFolder.Name
i = i + 1

Next objSubFolder

End Sub


En somme, je cherche à ce que la macro ouvre chaque dossier, en liste le nom, ouvre le fichier txt et le convertisse en xlsx, et extraie certaines informations des fichiers xlsx dans le fichier source.

Il me semble que ça fait ce que ça doit faire mais ça me parait (excusez moi l'expression) assez 'bordélique' comme code. J'ai un peu bidouillé différentes macro pour les combiner et je ne sais pas trop comment vérifier le travail !

Je suis forcé d'avouer que je ne suis pas une fleche en VBA alors je procède fort en essais/erreurs

Aussi, la macro est assez lente sur les ~1000 dossiers que je dois traiter. Auriez-vous des idées pour l'optimiser ?

Merci d'avance

CL
Messages postés
16432
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
24 juillet 2021
880 >
Messages postés
38
Date d'inscription
jeudi 10 janvier 2013
Statut
Membre
Dernière intervention
5 avril 2018

est-il utile de sauver le fichier txt en xlsx?
en tous cas, moi j'essaierais, au lieu de ceci:
Set Wb = Workbooks.Open(strFile, Format:=6, Delimiter:=",")
'Save it as Excel file, same name as text file
Wb.SaveAs Left(strFile, InStrRev(strFile, ".") - 1), xlWorkbookDefault
Wb.Close
Set Wb = Nothing
Set Wb = Workbooks.Open(strDir & "\informations.xlsx")
' boulot
Wb.Close

de faire cela:
Set Wb = Workbooks.Open(strFile, Format:=6, Delimiter:=",")
' boulot
'Save it as Excel file, same name as text file
Wb.SaveAs Left(strFile, InStrRev(strFile, ".") - 1), xlWorkbookDefault
Wb.Close
Messages postés
38
Date d'inscription
jeudi 10 janvier 2013
Statut
Membre
Dernière intervention
5 avril 2018

ça fonctionne tout à fait ! Je ne savais pas que je pouvais appliquer cette procédure sur un fichier .txt directement, je pensais devoir le convertir en .xlsx ! Du coup, ça simplifie pas mal le travail :)

Merci pour votre aide !
Messages postés
16432
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
24 juillet 2021
880 >
Messages postés
38
Date d'inscription
jeudi 10 janvier 2013
Statut
Membre
Dernière intervention
5 avril 2018

pas utile non plus de faire le
Wb.SaveAs
, alors.
Messages postés
38
Date d'inscription
jeudi 10 janvier 2013
Statut
Membre
Dernière intervention
5 avril 2018

De fait, c'est accessoire :)

Merci !