Discussion :

[Geprocor]

Bonjour,

Je suis face à la problématique suivante :

> J'ai une multitude de fichiers photos (.jpg) dans un répertoire "A". Chaque fichier étant nommé par "8 chiffres".jpg

> Je voudrais, à l'aide des codes à 8 chiffres contenus dans un excel, identifier (voir copier dans un dossier "B") les photos concernées.

Je pense que c'est quelque chose de faisable mais je n'ai aucune idée de comment procéder.

Avez-vous une idée de ma marche à suivre?

En espérant avoir été clair, merci d'avance.

Cdt

MC

[neupont]

Salut,
A priori si le nom des fichiers à copier est dans une feuille Excel tu n'as pas besoin de VBA mais juste de petites astuces.
Pourquoi ne pas faire un batch par exemple ? Il suffit de copier la colonne des noms dans un fichier texte, de faire précéder chaque nom par "xcopy c:\RépertoireA\" et de le faire suivre par " c:\RépertoireB"

Tu enregistres le fichier texte en question avec une extension .bat et le tour est joué.

Evidemment si c'est quelque chose à faire souvent, l'élaboration d'une macro peut devenir plus rentable.

[Geprocor]

Merci,

En effet, ça semble plus simple.
Mais, effectivement, c'est une opération qui sera faite souvent et par divers personnes, donc je dois la simplifier au maximum.
De plus, ces opérations devront permettre de déplacer bcp d'image à chaque fois (parfois 100 ou 200), donc pas tres simple.

En tous cas merci pour cette idée

[neupont]

Alors il faut une boucle qui utilise FileCopy, par exemple.
Je te mets un exemple simpliste (et pas testé) à adapter

Code :

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

1
2
3
4
5
6
7
8
9
10
 
dim repertoireSource as String, repertoireCible as String
repertoireSource = "C:\RepertoireA\"
repertoireCible = "C:\RepertoireB\"
'imagine que tes fichiers se suivent sans interruption en colonne A (colonne n°1 donc) et que la liste commence en ligne 2 :
i = 2
do while cells(i,1) <> ""
   FileCopy repertoireSource & cells(i,1) & ".jpg", repertoireCible & cells(i,1) & ".jpg"
   i = i+1
loop

[tomy7]

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
dim repertoireSource as String, repertoireCible as String
Dim i as integer
Dim fso As New FileSystemObject
Line= activesheet.cells(rows.count, "A").end(xlup).row
for i = 1 to Line
 
repertoireSource = "C:\RepertoireA\"
repertoireCible = "C:\RepertoireB\"
 
 If range("A"& i).value = ""
  fso.CopyFile repertoireSource & cells(i,1) & ".jpg", repertoireCible & cells(i,1) & ".jpg"
  end if
 
next i

tu peux aussi le faire comme sa...

@+
tom

[Geprocor]

Super (bon début) !!

j'ai donc fait ça :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub deplace_visuels()
 
Dim repertoireSource As String, repertoireCible As String
repertoireSource = "C:\RepA\"
repertoireCible = "C:\RepB\"
'imagine que tes fichiers se suivent sans interruption en colonne A (colonne n°1 donc) et que la liste commence en ligne 2 :
i = 2
Do While Cells(i, 1) <> ""
   FileCopy repertoireSource & Cells(i, 1) & ".jpg", repertoireCible & Cells(i, 1) & ".jpg"
   i = i + 1
Loop
 
End Sub

Ca fonctionne mais que pour les 6 premières lignes...

Dès qu'un visuel n'est pas présent dans mon répertoireA, j'ai un message d'erreur "le fichier est introuvable" et la macro s'arrete

ça avance

[Geprocor]

@ Tom :
Merci, j'ai essayé ta proposition mais j'ai un message d'erreur:
"erreur de compilation : type défini par l'utilisateur non défini"
(pour la ligne fso As New FileSystemObject)

[tomy7]

une de tes reference n est pas active

VBA>outils>reference> tu coches MS scripting runtime.

et la c est bon

j ai oublie le "Then" dans le code que je t ai donne

[Geprocor]

J'ai cocher la case et rajouter le "then"

Code :

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

1
2
3
If range("A"& i).value = "" then
  fso.CopyFile repertoireSource & cells(i,1) & ".jpg", repertoireCible & cells(i,1) & ".jpg"
  end if

Il me dit "fichier introuvable"...

[neupont]

Dès qu'un visuel n'est pas présent dans mon répertoireA, j'ai un message d'erreur "le fichier est introuvable" et la macro s'arrete

Si c'est le seul type d'erreur qui risque de survenir, tu peux mettre au début du traitement "on error resume next" qui saute les erreurs et fait passer au traitement suivant.

Sinon tu peux faire des tests plus spécifiques.
Avec le fso il doit exister une fonction FileExists.
Sans le fso, tu dois pouvoir tester l'existence préalable du fichier avec la commande Dir

[ouskel'n'or]

Si tu n'as que des jpg dans ton répertoire, alors pourquoi ne pas simplement copier le répertoire ? Regarde à CopyFile ou CopyFolder dans l'aide en ligne.
Mais tu n'es pas obligé d'ajouter la référence Microsoft Sripting Runtime si tu mets cette syntaxe qui copie les fichiers(.jpg) d'un répertoire dans l'autre, pas le répertoire lui-même

Code :

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

1
2
3
4
5
Sub test()
Dim fs as variant
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile "C:\Documents and Settings\neupont\Mes images\*.jpg", "c:\Images\"
End Sub

Je crois que tu as maintenant toutes les méthodes utilisables

[neupont]

Code :

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

1
2
fs.CopyFile "C:\Documents and Settings\neupont\Mes images\*.jpg", "c:\Images\"

Mais euh, pourquoi en rouge ?

Ceci dit je crois que justement il ne veut pas copier tous les jpg, mais seulement ceux qui sont référencés dans Excel (sauf erreur).

[tomy7]

si le fichier est introuvable c est que tu as peut etre mal ecris tes repertoire:

Code :

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

fs.CopyFile "C:\Documents and Settings\neupont\Mes images\*.jpg", "c:\Images\"

verifie les \ , pour cela utilise 2:
msgbox repertoireSource
msgbox repertoireCible

insere les dans le IF apres le then...

[ouskel'n'or]

Mais euh, pourquoi en rouge ?

Parce que je me suis gouré et que j'ai cru que c'était toi qui posais la question
Mais tu as raison, à propos des fichiers à copier. Je laisse mon post, des fois que ça intéresse quelqu'un... Et puis on n'est toujours pas obliger de valider la référence Microsoft scripting runtime pour utiliser fso
(je m'en sors comme je peux )

[tomy7]

Et puis on n'est toujours pas obliger de valider la référence Microsoft scripting runtime pour utiliser fso

si je ne coche pas MS scripting runtime.
J ai un bug user defined type not defined... Ousk peux tu m expliquer comment tu fais sans la reference?

Merci
Tom

[Geprocor]

J'ai rajouté "on error resume next" dans la solusion de neupont et ça marche super

Maintenant que celà fonctionne, je voudrais aller plus loin...

Est-il possible d'identifier les fichiers manquants et éventuellemen de changer leur mise en forme ou les déplacer?

En tous cas MERCI à tous.
(grace à vous, je vais pouvoir demander une promotion à mon patron )

[neupont]

Alors tu ne vas pas pouvoir utiliser le "on error resume next" (il est vrai que c'était la solution de facilité), mais devoir véritablement tester l'existence de chaque fichier.
S'il est présent tu le copies.
S'il ne l'est pas, tu le mets en rouge dans excel, ou autre solution.

Et pour ça, c'est vrai que le FSO avec une condition de FileExists est sans doute le plus indiqué.

[ouskel'n'or]

Tu crée un tableau des fichiers manquants que tu identifies selon l'erreur

Code :

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

1
2
3
4
5
6
7
8
9
Dim Tablo(0) as string, i as integer
On error resume next
     Ton code de copie
     if err <> 0 then
          i = i + 1
          Redim Preserve Tablo(i)
          Tablo(i) = NomDuFichier
     endif
     err.clear

et pour récupérer tes noms de fichiers

Code :

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

1
2
3
For i = 1 to Ubound(Tablo)
     msgbox tablo(i)
Next

Pour placer ces noms dans une feuille, tu sauras faire

[tomy7]

si ton patron cherche des jeunes qui ont bientot fini leurs stage... demande pour moi...LOl

utilise la methode fso et tu fais un test avec FileExists : regarde ds l aide VBA.

tu entends quoi par changer leur formes?

[ouskel'n'or]

si je ne coche pas MS scripting runtime.
J ai un bug user defined type not defined... Ousk peux tu m expliquer comment tu fais sans la reference?
Merci
Tom

Comme ça