Boucle sur fichiers

**Junfiizz** · 22/02/2017, 13h03

Bonjour.

Je reviens vers vous car j'ai un dernier soucis sur ma maccro.
Celle-ci me permet de boucler sur tout les fichiers excel afin de ressortir certaines informations dans un autre classeur (Recupdevis)

Ma boucle est écrite comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
Dim Dossier As String
    Dossier = "C:\Users\controlegestion\Documents\Mel\Devis"
 
Dim Fso As New Scripting.FileSystemObject
 
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
 
Dim Subfolder As Scripting.Folder
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Subfolder = Fso.GetFolder("C:\Users\controlegestion\Documents\Mel\Devis")
 
Dim Sourcefolder As Scripting.Folder
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Sourcefolder = Fso.GetFolder("C:\Users\controlegestion\Documents\Mel\Devis")
 
Dim Filesitem
    Set Filesitem = CreateObject("Scripting.FileSystemObject")
    Set Filesitem = Fso.GetFile("C:\Users\controlegestion\Documents\Mel\Recupdevis.xlsm")
 
Dim fi1 As Object, fi2 As Object, fi3 As Object
 
'Pour tout dossier ce trouvant dans le dossier sources (devis)
    For Each fi1 In Fso.GetFolder(Dossier).SubFolders
' Pour tout fichiers se trouvant dans les dossiers (fi1), se trouvant eux même dans le dossier source (devis)
    For Each fi2 In fi1.SubFolders
' Pour tout sous-dossiers se trouvant dans les dossiers (fi1)
    For Each fi3 In fi2.Files
 
        If fi3.Type = "Feuille de calcul Microsoft Excel 97-2003" Then
 
            ' Ouvrir le fichier
            Set wbk = Workbooks.Open(fi3, 0)

Le soucis c'est qu'en réalité ça ne boucle pas sur tout. En effet, les fichiers présent a la racine ne sont pas pris en compte, seul ceux présent dans des sous-dossiers. En gros si j'ai :

[Dossier Devis]
-> [Client1]
->[Client1devisn°x]
-> Devisn°x.xls

La maccro va bien me trouver le devis n°x

Mais si j'ai
[Dossier]
-> [Client1]
-> Devisn°x.xls

La maccro va "ignoré" le fichier et donc ne jamais me ressortir les informations voulut. J'aurais put créer un sous-dossiers dans client1, mais malheureusement j'ai plus de 250 clients, et en plus je n'ai pas l'autorisation pour créer les sous-dossiers enfin, on m'interdit de toucher au réseau zcom.

J'ai bien essayer comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
'Pour tout dossier ce trouvant dans le dossier sources (devis)
    For Each fi1 In Fso.GetFolder(Dossier).SubFolders
' Pour tout fichiers se trouvant dans les dossiers (fi1), se trouvant eux même dans le dossier source (devis)
    For Each fi2 In fi1.SubFolders
' Pour tout sous-dossiers se trouvant dans les dossiers (fi1)
    For Each fi3 In fi2.Files
    For Each fi4 In fi1.Files

Mais du coup, ça ne boucle plus du tout, enfin si mais ça ne trouve rien.

Un coup de main? Merci d'avance!

**CaptainMeta** · 23/02/2017, 11h46

Salut,

As tu essayé un truc comme ça?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
'Pour tout dossier ce trouvant dans le dossier sources (devis)
			If fi3.Type = "Feuille de calcul Microsoft Excel 97-2003" Then
				 ' Ouvrir le fichier
Set wbk = Workbooks.Open(fi3, 0)
		Next fi3
	Next fi2
	For Each fi4 in fi1.files
		If fi4.Type="........" then
			Ouvrir le fichier
	Next fi4
Next fi1

Avec l'absence d'indentation et de next, je ne suis pas sûr de l'organisation des boucles de ton code corrigé..

A+

Captain

**Junfiizz** · 23/02/2017, 11h58

Bonjour CaptainMeta.

Merci de ta réponse, bien que au final j'ai finis par trouvé par moi même (enfin c'est la même chose que ta proposition) en farfouillant sur le forum ce matin, je n'avais malheureusement pas eu le temps hier.

Du coup, maintenant cela ressemble a ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 
Sub ListesFichiers(Dossier As String)
 
Dim Fso As New Scripting.FileSystemObject
    Set Fso = CreateObject("Scripting.FileSystemObject")
 
Dim Subfolder As Scripting.Folder
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Subfolder = Fso.GetFolder(Dossier)
 
Dim Sourcefolder As Scripting.Folder
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Sourcefolder = Fso.GetFolder(Dossier)
 
Dim Filesitem As Scripting.File
 
'Pour tout dossier ce trouvant dans le dossier sources (devis)
    For Each Filesitem In Sourcefolder.Files
 
    'Cherche la dernière ligne non vide, lui ajoute +1 pour inscrire dans la prochaine ligne (i représente la ligne) Si i =2, les données s'inscriront
    'dans la ligne 2
    i = Range("A" & Rows.Count).End(xlUp).Row + 1
 
        'Si les fichiers trouvé sont des fichiers excel version 97-2003 alors
        If Filesitem.Type = "Feuille de calcul Microsoft Excel 97-2003" Then
 
            ' Ouvrir le fichier
            Set wbk = Workbooks.Open(Filesitem, 0)
 
- Suites d'instructions -
 
'Passe au prochain fichier trouvé
Next Filesitem
 
        'Permet de lister les sous-dossiers dans les dossiers, et permet de trouver tout les fichiers a la racine des dossiers, comme dans les
        'sous-dossiers, puis passe au dossier suivant, et retour au premier For Each du programme
        For Each Subfolder In Sourcefolder.SubFolders
            ListesFichiers Subfolder.Path
        Next Subfolder
 
End sub

Merci la FAQ! (Promis je la consulterais plus souvent dorénavant.) Et merci a toi d'avoir pris du temps pour mon problème!