Macro Extraction Fichiers

Bonjour à tous,

Je suis en train de créer une macro dans le but suivant : j'ai une liste de références de produits dans un fichier Excel et je souhaite extraire automatiquement (grâce à ma macro) toutes les images correspondant à cette référence dans un dossier à part. Toutes mes images sont nommées par la référence produit.

J'ai réussi à créer la macro qui permet de copier coller les photos dans un dossier à part, mais mon problème, c'est que pour la faire fonctionner, je dois rentrer le nom exact du visuel en question pour chaque référence. Or, pour une même référence, je peux avoir plusieurs visuels nommés par la référence + "(01)", "(02)"...

Je souhaiterai donc demander à ma macro d'extraire les photos en question si le titre de la photo CONTIENT le numéro de ma référence (j'insiste bien sur le "contient" car je ne souhaite pas écrire le nom extact de ma photo, la procédure prendrait trop de temps lorsque je dois en extraire un grand nombre). Et je ne parviens pas à indiquer ma macro que je souhaite extraire la photo si la référence est contenue dans mon nom d'image.

En pièce jointe mon ébauche de macro. En espérant que quelqu'un pourrait m'éclairer sur mon problème !!

Merci d'avance

(PS : je suis encore débutante, la solution est peut être très simple)

Bonjour,

Tu peux faire une comparaison comme ceci :

If NomFichier Like "*" & ReferenceProduit & "*" Then...

Bonjour Pedro,

Merci pour ton aide. J'ai essayé d'ajouter ce code au mien, cependant, cela ne fonctionne pas : j'obtiens le message d'erreur "Fichier introuvable" alors que la macro devrait trouver 6 fichiers.

Voici le code :

Sub repCopierFichier()

Dim fso As Object, Dossier_origine$, Dossier_récepteur$, Fichier_cherché$, Reference$

Set fso = CreateObject("Scripting.FileSystemObject")

Dossier_récepteur = Range("F12")

Range("B12").Activate

Do Until ActiveCell = ""

Dossier_origine = ActiveCell

Fichier_cherché = ActiveCell.Offset(0, 1)

If Dossier_origine & "\" & Fichier_cherché Like "*" & ActiveCell.Offset(0, 7) & "*" Then

End If

fso.CopyFile Dossier_origine & "\" & Fichier_cherché, Dossier_récepteur & "\" & Fichier_cherché

ActiveCell.Offset(1, 0).Activate

Loop

End Sub

Ai-je un raté ?

Merci encore pour ton aide

Ton code fait en grande partie référence aux données de ta feuille, que tu ne nous a pas communiqué... Donc difficile de t'aider avec les éléments actuels.

En effet, j'admets que sans exemple ce n'est pas clair. J'ai simplifié le fichier et y ai ajouté des exemples (voir ci joint).

Dans mon exemple j'ai une liste de 5 références (52202, 52353...).

Pour chacune de ces références, j'ai un certain nombre d'images correspondant.

Le nom de ces images contient systématiquement la référence, suivie d'un "(01)", "(02)"...

Je souhaite donc copier-coller les images (qui contiennent dans leur titre le nom de ma référence) situées dans le dossier d'origine dans le dossier de destination.

J'espère que grâce à cela mon problème sera plus clair à comprendre

Essaie avec ce code :

Sub repCopierFichier()

Dim fso As Object, Dossier_cherché$, Dossier_récepteur$, Fichier_cherché$
Dim Lig As Integer, LigMax As Integer

Set fso = CreateObject("Scripting.FileSystemObject")
Dossier_récepteur = Range("F12")
LigMax = Range("A" & Rows.Count).End(xlUp).Row

For Lig = 12 To LigMax
    Dossier_cherché = Range("B" & Lig)
    Fichier_cherché = Range("C" & Lig)
    Fichier = Dir(Dossier_cherché)
    Do While Fichier <> ""
        If Fichier Like "*" & Fichier_cherché & "*" Then fso.CopyFile Dossier_cherché & Fichier, Dossier_récepteur & Fichier
        Fichier = Dir
    Loop
Next Lig

End Sub

J'ai repéré plusieurs erreurs sur ton code précédent :

• Dossier_origine se termine par un "\", pourtant, tu veux en ajouter un : "...Dossier_origine & "\" &..."
• Ce code est inutile dans la mesure où tu ne mets aucune instruction entre "Then" et "End If" :

If Dossier_origine & "\" & Fichier_cherché Like "*" & ActiveCell.Offset(0, 7) & "*" Then
End If

• ActiveCell.Offset(0, 7) ne correspond à rien, c'est une cellule vide
• Le nom d'un fichier manipulé par Excel tiens compte du type de fichier, il me semble (".xlsx", ".jpeg"...) qui est donc à ajouter, sauf si tu récupère déjà cette info avec un nom de fichier.

Au final j'ai modifié ton écriture, que je trouve très alambiquée...

Mille mercis !! Ton code fonctionne parfaitement !

Il ne me reste plus qu'à tout comprendre pour pouvoir reproduire si besoin une prochaine fois !

Cette macro va me changer la vie pour mon travail et va me faire gagner de précieuses heures chaque semaine !!

Dernière question : après avoir lancé ma macro, quand elle a finit de travailler, j'ai un message d'erreur qui indique "Permission refusée". Je n'ai jamais eu de message de ce type. Sais-tu à quoi il fait référence ?

Je n'en ai aucune idée ! A vrai dire j'ai mixé des bouts de ton code avec lesquels je ne suis pas familier...

D'accord, pas d'importance, cela n'empêche pas la macro de fonctionner. C'était plutôt par curiosité.

Merci encore !!