Recherche récursive et copie de fichier

[Emmanuel31]

Bonjour à tous.

Je suis à la recherche de code VBA pour faire une recherche récursive à partir d'un répertoire "parent", et une fois le fichier trouvé, le copier dans un répertoire cible généré.
Les fichiers doivent contenir dans le nom une chaine de chiffre qui se trouve dans une colonne.

Dis comme ça , c'est pas très parlant ...

Le but est donc (si je segmente étape par étape pour essayer d'expliquer mieux) :
- prendre la valeur numérique des cellules dans la colonne A
- chercher des fichiers dont le nom contient la valeur numérique de manière récursive dans un répertoire parent (donné en paramètre dans un autre onglet ainsi que l'extension)
- si le (ou les) fichier est trouvé, créer un répertoire à un endroit donné (en paramètre dans un autre onglet) portant le nom de la valeur numérique cherché en colonne A, et copier le fichier trouvé dans ce répertoire
- mettre en colonne B un lien hypertexte vers le répertoire créé s'il existe.

Un exemple parle souvent beaucoup plus que du blabla !
Donc voici en fichier joint la structure de base, avec un onglet paramètre où sont les ... paramètres ... et un onglet ID où sont mes éléments à chercher.

Quelqu'un peut-il m'aider svp ?
Merci.

 

[Emmanuel31]

Re : Recherche récursive et copie de fichier

Mon sujet ne passionne pas les foules :-(

 

[Emmanuel31]

Re : Recherche récursive et copie de fichier

Même pas un ch'ti bout de code ....?
(ça fait roumain aux feux rouges ça non ?)

 

[JNP]

Re : Recherche récursive et copie de fichier

Bonjour Emmanuel31 ,
Si tu fais des recherches sur le forum avec Fichier et Récursive, tu trouveras certainement ton bonheur ...
En attendant, tu peux jeter un oeil sur
https://www.excel-downloads.com/threads/lister-un-repertoire-et-les-sous-repertoires.148315/
et sur
https://www.excel-downloads.com/threads/copier-un-fichier-dans-plusieurs-repertoires.160861/
tu auras déjà 50% de ta réponse ...
Bon courage

 

[MichD]

Re : Recherche récursive et copie de fichier

Bonjour,

Dans la feuille ID de ton classeur, dans la colonne A3:A6, tu as des numéros que tu veux rechercher dans le répertoire de départ : "F:\Tests_Excels\Arbo_test\" et dans tous les sous-répertoires.

A ) Est-ce que ce numéro peut se retrouver dans plus d'un nom de fichier d'un sous-répertoire ? Si oui, veux-tu créer des liens hypertextes pour chaque chemin trouvé ? Ce lien hypertexte doit pointer vers le répertoire de destination "F:\Tests_Excels\ID\" + le numéro contenu dans la cellule ? Doit-on y copier le fichier trouvé ? Comme dans ton tableau en feuille ID ne prévoit qu'une cellule pour ces liens, s'il y a plus d'un lien, où veux-tu les créer ?

B ) Tu parles de la création de répertoire, où se répertoire doit-il être créé ? On doit créer un répertoire du nom du contenu de la cellule recherchée dans ce répertoire : "F:\Tests_Excels\ID\" . C'est tout ?

 

[Emmanuel31]

Re : Recherche récursive et copie de fichier

Dans la feuille ID de ton classeur, dans la colonne A3:A6, tu as des numéros que tu veux rechercher dans le répertoire de départ : "F:\Tests_Excels\Arbo_test\" et dans tous les sous-répertoires.

C'est exactement ça !

A ) Est-ce que ce numéro peut se retrouver dans plus d'un nom de fichier d'un sous-répertoire ?

Oui.

Si oui, veux-tu créer des liens hypertextes pour chaque chemin trouvé ?

Non , le but est de copier tous ces fichiers trouvés dans un répertoire créé par la macro portant le nom de l'ID.
Et le lien hypertexte doit juste pointer sur le répertoire ainsi créé (s'il existe , c-a-d s'il a été créé).

Ce lien hypertexte doit pointer vers le répertoire de destination "F:\Tests_Excels\ID\" + le numéro contenu dans la cellule ?

C'est ça !

Doit-on y copier le fichier trouvé ?

C'est ça (leS fichierS trouvéS) ;-)

Comme dans ton tableau en feuille ID ne prévoit qu'une cellule pour ces liens, s'il y a plus d'un lien, où veux-tu les créer ?

Une cellule car un seul lien vers le répertoire créé avec l'ID, si des fichiers ont été trouvés et copiés dans celui-ci biensur.

B ) Tu parles de la création de répertoire, où se répertoire doit-il être créé ?

Dans le répertoire définit via la valeur Paramètres!A6 .

On doit créer un répertoire du nom du contenu de la cellule recherchée dans ce répertoire : "F:\Tests_Excels\ID\" . C'est tout ?

C'est ça !

J'ai essayé d'expliquer dans l'onglet "Paramètres" l'existant et la cible mais sans doute n'est-ce pas très clair.
J'espère que les réponses à tes questions vont aider à mieux comprendre le process cherché ...

En tous cas , merci pour ton aide MichD !

 

[MJ13]

Re : Recherche récursive et copie de fichier

Bonjour à tous

merci pour ton aide MichD

Euh, et Jean-Noël, il pue de la G....e (ou tu ne l'as peut-être pas vu) .

Emmanuel31: Désolé, mais ça me démangeait : Je n'aime pas trop cette conception des forums. Si quelqu'un te fait ça, c'est super pout toi. Mais bon, il aura travaillé quelques heures (ou quelques minutes pour certains). Après on va pas venir se plaindre du départ des grandes pointures d'XLD commes Kjin.

Mais si toi tu, t'y mets, tu vas surement apprendre de ton expérience et devenir meilleur en VBA .

En plus, tu vas mettre où tu en es avec ton fichier à jour avec tes problèmes sur tel ou tel point. Et la, ça profitera à tout le monde .

Et enfin, c'est toi qui viendra aider sur XLD .

 

[Emmanuel31]

Re : Recherche récursive et copie de fichier

Merci pour ton intervention MJ13.

Effectivement j'ai oublié de remercier JNP également.

Saches juste que je me suis déjà penché sur ce problème en mettant du code que j'ai déja mis en place. (pos https://www.excel-downloads.com/threads/lien-hypertexte-dans-cellule.173433/).

Le fait est qu'avec mes macros actuelles (cités dans le post ci-dessus) je fait une recherche de fichiers unitaires dans un répertoire depuis des valeurs renseignés via un ID similaire au cas présent.
Ensuite je rajoute un lien hypertexte sur la même cellule qui a fait l'objet du test.

Or ici mon approche est totalement différente et faisant appel à des composantes que je ne maitrise pas recherche récursive , création de dossiers et copie de fichiers , le tout en boucle.

Aussi à la place de coder mal dès le début, je demande de l'aide sur des choses que je ne connait pas.

Le but n'est pas de "vampiriser" et de faire créer le bout de code par d'autres (bien que sur ce sujet précis c'est un peu le cas ...).

J'ai déjà fait des interventions sur le forums ou j'ai mis à disposition de la communauté des fichiers tels que des suivis de planning annuel d'équipe de travail, un calendrier perpétuel, etc ... élaboré par mon travail personnel et avec l'aide des XLDnautes (sur des éléments que je en maitrisais pas non plus).

Bref, je ne veux pas prouver ma bonne foi mais je veux juste rétablir un juste milieu ...

 

[MJ13]

Re : Recherche récursive et copie de fichier

Re Emmanel

Bref, je ne veux pas prouver ma bonne foi mais je veux juste rétablir un juste milieu

Ok, je note .

En espérant que quelqu'un te vienne en aide sur ces problèmes complexes .

 

[Emmanuel31]

Re : Recherche récursive et copie de fichier

MichD à l'air bien partant et on a déjà développé "ensemble" (un bien grand mot car il m'a beaucoup aidé au débug de mes macros)

 

[JNP]

Re : Recherche récursive et copie de fichier

Re ,

Euh, et Jean-Noël, il pue de la G....e (ou tu ne l'as peut-être pas vu) .

Merci Michel de ton intervention
Certes MichD a bien cerné la demande, mais effectivement, ça n'empêche pas que 50% de la demande trouve réponse dans les posts précités ...
Apréhender (personnellement, ce n'est toujours pas de l'acquis ) la récursivité, demande plus que des qualités de programmeurs ...
Après c'est vrai qu'un programmeur (c'était mon réflexe au début, depuis, je me soigne ) préferre faire du neuf que de repartir sur du code d'un autre...
Pour moi, le vrai reflexe, c'est de reprogrammer le code d'un autre (sans pour autant oblitérer ses sources ), afin de me l'approprier et de le comprendre
Dommage que tu ne sois pas avec nous ce WE ...
Bon WE

 

[MichD]

Re : Recherche récursive et copie de fichier

Bonjour,

Copie ce qui suit dans un module standard :

Option Explicit
Option Compare Text

Dim FS As Object
Dim Existe As Boolean
Const Destination = "F:\Tests_Excels\ID\"
'-----------------------------------------------------
Sub Test_GetFolder()
Dim Chemin As String, expression As String
Dim C As Range

'Répertoire de départ
Chemin = "F:\Tests_Excels\Arbo_test"

Set FS = CreateObject("Scripting.FileSystemObject")

With Worksheets("ID") 'Nom Feuille à définir
    For Each C In .Range("A3:A" & _
                    .Range("A65536").End(xlUp).Row)
        If C <> "" Then
            Existe = False
            expression = C.Value
            Call GetFolders(Chemin, expression, C, True)
        End If
    Next
End With
'Ce qui précède testait le contenu des sous-répertoires
'cette ligne teste le contenu source lui-même.
Call Trouver_Copier_Fichier(Chemin, expression, C)
Set FS = Nothing
End Sub
'-----------------------------------------------------
Function GetFolders(Chemin As String, _
    expression As String, Rg As Range, _
    Optional Récursif As Boolean)
Dim répertoire As String
Dim MyFolder As Object, MySubFolder As Object

Set MyFolder = FS.GetFolder(Chemin)

'si récursif est égale à true, rappel de la fonction
If Récursif Then
    'Boucle pour chaque sous-répertoire
    For Each MySubFolder In MyFolder.SubFolders
        répertoire = Chemin & "\" & MySubFolder.Name
        'Recherche fichier  + copie si trouve
        Call Trouver_Copier_Fichier(répertoire, expression, Rg)
        'Vérifier le sous-répertoire
        GetFolders MySubFolder.Path, expression, Rg, True
    Next
End If
End Function
'-----------------------------------------------------
Sub Trouver_Copier_Fichier(répertoire As String, _
                expression As String, Rg As Range)
Dim Fichier As String

'Recherche fichier contenant "Expression définie"
'ayant une extension de fichier ".pdf"
Fichier = Dir(répertoire & "\" & "*" & _
            expression & "*" & ".pdf")
Do While Fichier <> ""
    'Existe = true si le répertoire-destination
    ' a été créée
    If Existe = False Then
        'création du répertoire
        Call Créer_Répertoire(expression)
        'Créer le lien hypertexte
        Rg.Offset(, 1).Hyperlinks.Add Rg.Offset(, 1), _
            Destination & expression, , , _
                    Destination & expression
        Existe = True
    End If
    'Copie du fichier vers le nouveau répertoire
    FS.CopyFile répertoire & "\" & Fichier, _
            Destination & expression & "\" & Fichier
    Fichier = Dir()
Loop
End Sub
'-----------------------------------------------------
Sub Créer_Répertoire(expression As String)
Dim Commande As String, Lecteur As String
Dim T As Double
'S'assurer d'être sur le bon lecteur où les
'répertoires doivent être créé
Lecteur = Left(Destination, 1)
ChDrive Lecteur
Commande = Environ("comspec") & " /c mkdir " & _
                        Destination & expression
Shell Commande, 0
T = Timer + .4
Do While Timer <= T
     DoEvents
Loop
 
End Sub
'-----------------------------------------------------

 

[Emmanuel31]

Re : Recherche récursive et copie de fichier

Merci encore MichD !

J'ai fait quelques modifs afin de passer en paramètre le répertoires source et destination ainsi que l'extension de fichier.

Note pour moi pour plus tard : pensez à superbien commenter mes macros comme MichD

Truc que je ne comprends pas par contre :
ça fonctionne bien en pas à pas, mais en exécution totale, ça plante sur

'Copie du fichier vers le nouveau répertoire
FS.CopyFile répertoire & "\" & Fichier, _
Destination & expression & "\" & Fichier

Bizarre ce comportement ...

 

[MichD]

Re : Recherche récursive et copie de fichier

As-tu un message d'erreur ? Lequel ?

Afficher la fenêtre "Excécution" dans la fenêtre de l'éditeur de code

Juste avant la ligne de code problème tu écris :

Debug.Print répertoire & "\" & Fichier, Destination & expression & "\" & Fichier

FS.CopyFile répertoire & "\" & Fichier, _
Destination & expression & "\" & Fichier

Dans la fenêtre Exécution, tu retrouveras chacune des lignes de commande pour la copie et tu pourras vérifier si la syntaxe est bonne et si les répertoires et fichiers existent vraiment sur la ligne où cela bogue !

 

[Emmanuel31]

Re : Recherche récursive et copie de fichier

J'ai bien un message d'erreur "Chemin d'accès introuvable" alors qu'il vient bien de créer le répertoire "F:\Tests_Excels\ID\110110" ...

En pas à pas , pas de problème ...
Est-ce "trop" rapide entre la création du répertoire et la copie du fichier dedans ?