Discussion :

[misterjuicelink]

Bonjour tout le monde

je promets, j'ai cherché avant !
j'ai trouvé différentes choses, plus ou moins complexes, mais mon niveau fait que j'ai tendance à me concentrer sur les codes plus courts que je trouve, car je me perds parfois...

J'ai besoin de faire une macro qui teste tous les sous répertoires d'un emplacement réseau, et qui, à chaque fois qu'il rencontrer un fichier "FEC" (#amiscomptables), me copiera/collera le fameux fichier dans un certain endroit. (Pas confiance dans notre infogérant dont les sauvegardes sont aléatoires, et ce sont les fichiers les plus importants pour un cabinet comptable...)
Pour détecter si le fichier en question est un fichier FEC, pas de souci, ils sont faciles à repérer, ce sont des fichiers textes qui commencent par 9 chiffres suivis de "FEC", du genre "123456789FEC20221231.txt" : Ca, c'est ok je sais faire
Pour la partie copier/coller du fichier, pas de souci, je sais faire aussi

Ce que je n'arrive pas à faire, c'est qu'il ne va que sur un seul niveau de sous dossier... je ne trouve pas le code qui va bien pour aller tester plus profond dans les sous dossiers
du coup, je pense que je ne pars pas sur la bonne idée de base...

voila ce que j'ai fait, ça me semble un peu trop simpliste, et je suppose qu'avec cette méthode, il faudrait prévoir autant de "f"x qu'il n'y a de sous dossiers, sauf que je ne peux pas le prévoir à l'avance...
j'ai fait un repertoire test sur mon bureau avec 3 niveaux de sous dossiers, dont un vide, histoire de tenter de feinter excel

Si vous avez de quoi m'aider, je vous en serai tellement reconnaissant

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
 
Sub Fec_test_4()
Dim MonRepertoire As String
Dim Num As String
Dim Fso As Object
Dim F1 As Object, F2 As Object
Dim NomFichier As String
 
Set Fso = CreateObject("scripting.filesystemobject")
MonRepertoire = "C:\Users\ferrier\Desktop\test extraction fec\"
 
For Each F1 In Fso.GetFolder(MonRepertoire).SubFolders
    For Each F2 In F1.Files
 
    NomFichier = Right(F2, Len(F2) - Len(F1) - 1)
        If IsNumeric(Left(NomFichier, 9)) And Right(Left(NomFichier, 12), 3) = "FEC" Then
        MsgBox MonRepertoire & NomFichier 'à remplacer in fine par le copiage/collage du fichier
        Else
        End If
    Next F2
Next F1
 
End Sub

un grand merci par avance de toute aide
julien

[Franc]

Bonjour, tu as besoin d'une fonction récursive qui parcourt chaque dossier et s'appelle elle-même pour chaque sous-dossier trouvé.
Voici la fonction , que j'ai ensuite intégrée dans ta macro:

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
Function Recurse(sPath As String) As String
 
    Dim FSO As New FileSystemObject
    Dim myFolder As Folder
    Dim mySubFolder As Folder
    Dim myFile As File
    Dim NomFichier As String
 
    Set myFolder = FSO.GetFolder(sPath)
    For Each myFile In myFolder.Files
        NomFichier = myFile.Name
        If IsNumeric(Left(NomFichier, 9)) And Right(Left(NomFichier, 12), 3) = "FEC" Then
            MsgBox sPath & NomFichier 'à remplacer in fine par le copiage/collage du fichier
        End If
    Next myFile
 
    For Each mySubFolder In myFolder.SubFolders
        Recurse = Recurse(mySubFolder.Path)
    Next
 
End Function

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub Fec_test_4()
 
    Dim MonRepertoire As String
    Dim FSO As Object
 
    Set FSO = CreateObject("scripting.filesystemobject")
    MonRepertoire = "C:\Users\ferrier\Desktop\test extraction fec\"
 
    Call Recurse(MonRepertoire)
 
End Sub

[misterjuicelink]

Bonjour, tu as besoin d'une fonction récursive qui parcourt chaque dossier et s'appelle elle-même pour chaque sous-dossier trouvé.
Voici la fonction , que j'ai ensuite intégrée dans ta macro:

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
Function Recurse(sPath As String) As String
 
    Dim FSO As New FileSystemObject
    Dim myFolder As Folder
    Dim mySubFolder As Folder
    Dim myFile As File
    Dim NomFichier As String
 
    Set myFolder = FSO.GetFolder(sPath)
    For Each myFile In myFolder.Files
        NomFichier = myFile.Name
        If IsNumeric(Left(NomFichier, 9)) And Right(Left(NomFichier, 12), 3) = "FEC" Then
            MsgBox sPath & NomFichier 'à remplacer in fine par le copiage/collage du fichier
        End If
    Next myFile
 
    For Each mySubFolder In myFolder.SubFolders
        Recurse = Recurse(mySubFolder.Path)
    Next
 
End Function

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub Fec_test_4()
 
    Dim MonRepertoire As String
    Dim FSO As Object
 
    Set FSO = CreateObject("scripting.filesystemobject")
    MonRepertoire = "C:\Users\ferrier\Desktop\test extraction fec\"
 
    Call Recurse(MonRepertoire)
 
End Sub

Merci de ta réponse !
alors en effet, j'avais vu qu'il y avait une possibilité avec cette fameuse fonction recursive, mais j'avoue que ça m'a fait peur...
je n'ai jamais trop su utiliser les fonctions... il faut mettre la fonction dans le module, comme la sub? ou faut la mettre ailleurs?

du coup, j'ai fait un copier coller de tes codes dans le module, mais j'ai un "Erreur de compilation : Type défini par l'utilisateur indefini" sur la ligne "Dim FSO As New FileSystemObject" de la fonction

julien

[misterjuicelink]

ahhhhhhhh j'ai trouvé !!!!
il fallait ajouter le "Microsoft Scripting Run-time" dans les références vba

je vais tester ca rapidement et te dirai si ça a marché en "situation réelle"


merci encore !