Copier fichiers

Bonjour a tous,

Existe t il un moyen de copier des fichiers via une macro?

Je m'explique j'ai une trentaine de dossier contenant des images.

J'aimerais créer un dossier "00-gabarit" (dans le même dossier parent que les autres dossier)avec une copie de ces images (Sachants qu'il y a parfois des images du même nom dans différents dossiers)

Merci de votre aide

Bonjour,

Voici un essai :

Sub copierdossier()

dim fso as object
dim dossbase$, nvdoss$

dossbase = "C\chemin\nomdossieracopier" 'repertoire dossier à copier
nvdoss = replace(dossbase, split(dossbase, "\")(ubound(split(dossbase, "\")), "NOMNOUVEAUDOSSIER") 'nouveau répertoire dans le même dossier parent
set fso = createobject("Scripting.FileSystemObject")

with fso
    .copyfolder dossbase, nvdoss, true 'copie du dossier
end with

end sub

Cdlt,

Merci 3GB

Mais ce que je souhaite faire c'est copier l'ensemble des images des "30" Dossiers dans le dossier de base "00-GABARIT"

Pour résumé:

J'ai un dossier avec une trentaines d'autres dossiers (nommés par des couleurs) et le dossier de base (00-Gabarit).

J'aimerais faire une copie des fichiers de chaque dossiers vers le dossier de base.

Bonjour Damsa,

Pourriez-vous me donner un tout petit peu plus de détails ? Le dossier parent contient 30 dossiers plus le dossier 00gabarit ou il en contient plus ? S'il en contient plus, qu'est-ce que ces dossiers ont en commun ?

Les dossiers ne contiennent-ils que des images ? Quelle est l'extension des images (.jpg uniquement ?) ?

Cdlt,

Voila un petit dessin vaut mieux qu'un grand discours ;-)

Le dossiers parents(Image) ne contient pas 30 mais plus (en comptant +/- 60) mais cela pourrait encore augmenter en plus du dossier 00-gabarit

Ceci dit il peut y avoir la même références dans plusieurs dossier couleur (a ce moment la on garde celui déjà présent)

Merci, en effet, c'est beaucoup plus parlant. Mais comment distinguer les dossiers dont les images sont à copier des autres ? Les autres ne contiennent pas d'image ? Sinon, il faudra leur donner un nom avec un préfixe ou un suffixe commun qui permettent de les identifier.

En fait j'aimerais que toutes les images de tout les dossiers soit copier dans le dossier 00-gabarit( ce dossier regroupe toutes les différentes images de tout les dossiers) ;-)

Bonjour Damsa,

Voici un nouvel essai, pour l'instant qui copie tous les fichiers de tous les sous-dossiers du dossier "Images" dans le sous-dossier "00-Gabarit".

Il faudra adapter le répertoire de "Images" bien sûr. Si vous ne voulez que les images, il faudra remplacer "\*.*" par "\*.png" dans la boucle for (voir les commentaires).

Sub CopierFichiers()

Dim dossiers()

repparent = "C:\...\Images\" '<<<< ADAPTER
If Dir(repparent & "00-Gabarit", vbDirectory) = "" Then MkDir repparent & "00-Gabarit" 'si dossier destination n'existe pas, on le crée

dossier = Dir(repparent, vbDirectory) '1ere entrée du dossier parent
While dossier <> "" 'tant qu'il reste des éléments à parcourir
    If dossier <> "00-Gabarit" And Not dossier Like "*.*" Then 'si dossier <> "Gabarit" et est bien un sous-dossier (pas un fichier "*.*" ni dossier courant "." ni dossier parent "..")
        ReDim Preserve dossiers(n) 'redimension du tableau listant les dossiers
        dossiers(n) = dossier 'item n vaut nom sous-dossier en cours
        n = n + 1 'incrementation n
    End If
    dossier = Dir 'suivant
Wend

For i = LBound(dossiers) To UBound(dossiers) 'pour chaque sous-dossier renvoyé
    fichier = Dir(repparent & dossiers(i) & "\*.*") '1er fichier du sous-dossier (<<< SI BESOIN : "\*.png")
    While fichier <> "" 'tant qu'il existe des fichiers
        pathorigine = repparent & dossiers(i) & "\" & fichier 'chemin origine
        pathdestination = repparent & "00-Gabarit" & "\" & fichier 'chemin destination
        FileCopy pathorigine, pathdestination 'copie et le cas échéant remplace le fichier dans destination
        fichier = Dir 'fichier suivant
    Wend
Next i

End Sub

Cdlt,

Super merci

Ca fonctionne nickel