[XL-2003] recherche un fichier dans des sous répertoire et recopier son contenu

[hallscar]

bonjour je souhaiterai réaliser le programme suivant à partir d'un fichier excel "1":

- chercher un fichier excel "2" qui se situe dans des sous-répertoires (sans indiquer le chemin exact, mais seulement en indiquant le répertoire racine à partir duquel chercher dans les sous répertoire le nom du fichier excel "2")
- lire et recopier le contenu de excel "2" dans le fichier excel "1"

Je vois qu'il y a plusieurs possibilités:
Application.FileSearch
Scripting.FileSystemObject

Mais je ne sais pas trop comment les utiliser...

[defluc]

Fait une recherche sur "recherche fichier récursive"

[hallscar]

merci des info
j'ai créé ce code

Code :

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
 
Sub Search_File_In_subfolders(FileName As String)
 
Dim chemin, répertoire, fichier, rep As String
Dim MyFolder As Object
Dim MySubFolder As Object
 
 
'Adresse de ThisWorkBook
chemin = ThisWorkbook.Path
 
'déclare l'objet FSO (gestion des dossiers et fichiers)
Set FS = CreateObject("Scripting.FileSystemObject")
 
'Déclare la méthode GetFolder de l'objet FSO
Set MyFolder = FS.GetFolder(chemin)
 
'Boucle pour parcourir chaque sous-répertoire
For Each MySubFolder In MyFolder.SubFolders
    répertoire = chemin & "\" & MySubFolder.Name
 
        'rep = répertoire & "\" & "*" & FileName & "*" & ".xls"
        rep = répertoire & "\" & FileName & ".xls"
 
 
        If FS.FileExists(rep) Then
            MsgBox "Existe"
        Else
            MsgBox "existe pas"
 
        End If
 
Next
 
 
End Sub

Cela permet de parcourir les différents sous-repertoires et de vérifier l'existance d'un fichier. En revanche, comment faire pour chercher un fichier avec une recherche partielle? du type :
'rep = répertoire & "\" & "*" & FileName & "*" & ".xls"
Le problème est que VBA rajoute les * au nom du fichier.

[defluc]

J'ai plusieurs observations.

1. Pour pouvoir utiliser le résultat dans d'autres procédures, il vaut mieux créer une fonctions
2. FileExists n'est pas adapté parce qu'il n'accepte pas les jokers du genre «*.xls»
3. Ta procédure n'étant pas récursive, elle ne trouvera que les fichiers qui se trouvent dans les répertoires du répertoire que tu as indiqué, mais pas dans les sous-répertoires.

Est-ce vraiment ce que tu veux ?
Si c'est le cas, il suffit de coder

Code :

  If Dir(répertoire & "\" & FileName) <> "" Then

au lieu de

Code :

        If FS.FileExists(rep) Then

Les jokers sont acceptés et ton problème est résolu.
Si tu veux que la recherche s'effectue dans les sous, les sous-sous et les sous-sous-répertoires, il faudra utiliser une fonction récursive.

[hallscar]

merci defluc, c'est bien cela que je veux faire avec la fonction récursive.

J'ai trouve cela :
http://warin.developpez.com/access/fichiers/

avec le code suivant :

Code :

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
Option Explicit
Sub Explorer(p_strFichier As String, p_strCheminDepart As String, Optional p_oFld As Scripting.Folder)
    'On Error GoTo err
 
    Dim oFSO As Scripting.FileSystemObject
    Dim oFld As Scripting.Folder
    Dim oFl As File
    If p_oFld Is Nothing Then
        'Instanciation du FSO (déclare l'objet FSO (gestion des dossiers et fichiers))
        Set oFSO = New Scripting.FileSystemObject
        'Accède au répertoire du départ de recherche
        Set p_oFld = oFSO.GetFolder(p_strCheminDepart)
    End If
 
    Set oFl = p_oFld.Files(p_strFichier)
    MsgBox oFl.Path
 
SubDir:
    'Explore les sous-dossiers
    For Each oFld In p_oFld.SubFolders
        Explorer p_strFichier, p_strCheminDepart, oFld
        DoEvents
    Next oFld
 
fin:
    Exit Sub
err:
    Select Case err.Number
        Case 53: Resume SubDir
        Case Else:
            MsgBox "Erreur inconnue"
            Resume fin
    End Select
 
End Sub

problème, quand j'execute la macro j'ai un "type défini par l'utilisateur non définir" sur la ligne :

Code :

Sub Explorer(p_strFichier As String, p_strCheminDepart As String, Optional p_oFld As Scripting.Folder)

[bbil]

bonsoir,

à relire : I-A. Introduction

N'oubliez pas d'ajouter la référence Microsoft Scripting Runtime à votre projet sans quoi une erreur sera levée.

[hallscar]

exact, je viens de voir cela à l'instant

Le code répond bien à mon besoin, part contre je sais pas comment le modifier pour faire une recherche partielle :

*nom partiel du fichier*

[hallscar]

voici la fonction :

Code :

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
Function Explorer(p_strFichier As String, p_strCheminDepart As String, Optional p_oFld As Scripting.Folder) As String
    On Error GoTo err
    
    Dim oFSO As Scripting.FileSystemObject
    Dim oFld As Scripting.Folder
    Dim oFl As File
    Dim rep As String
    If p_oFld Is Nothing Then
        'Instanciation du FSO (déclare l'objet FSO (gestion des dossiers et fichiers))
        Set oFSO = New Scripting.FileSystemObject
        'Accède au répertoire du départ de recherche
        Set p_oFld = oFSO.GetFolder(p_strCheminDepart)
    End If
    
    Set oFl = p_oFld.Files(p_strFichier)
    MsgBox oFl.Path
    Explorer = oFl.Path
    
SubDir:
    'Explore les sous-dossiers
    For Each oFld In p_oFld.SubFolders
        Explorer p_strFichier, p_strCheminDepart, oFld
        DoEvents
    Next oFld
    
fin:
    Exit Function
err:
    Select Case err.Number
        Case 53: Resume SubDir
        Case Else:
            MsgBox "Erreur inconnue"
            Resume fin
    End Select

End Function

afin terminer ma programmation , il me reste 2 problèmes à résoudre:
- le retour de la valeur de la fonction (chemin ou se trouve le fichier) ne fonctionne pas (voir ci dessus en gras). La fonction est appelée de la manière suivante:

Chemin = Explorer(FileName & ".xls", racine)

Une fois la fonction terminée, chemin est vide (renvoit : "")
- Est'il possible de faire une recherche partielle? (chercher un fichier qui contient l'expression que je donne).

@+

[hallscar]

Pour le 1er problème, cela semble venir de Exit function quand je lance la fonction en pas à pas, le explorer=ofl.path est bien enregistré, par contre explorer se vide une fois la ligne exit function exécutée.