Copier/Coller fichiers externes

[Blaise3113]

Help!!!!!!!!!!!!!!

Bonjour a tous,
j'ai un probleme :

J'ai un dossier ou figurent de nombreux fichiers dwg. Je possede une liste au format excel de dénominations. J'aimerais créer une macro qui lit la dénomination de la cellule active, rajoute le préfixe TE et l'extension .dwg, recherche le fichier dans le dossier, le copie et le colle dans un autre dossier, puis sélectionne la cellule i+1 et ainsi de suite. J'ai essayé mais je ne maitrise pas bien la fonction copie de fichier sous VBA...

Un petit exemple peut etre :

Dénomination sous excel: 1394
Va chercher le fichier TE1394.dwg dans répertoire source, copier coller vers répertoire destination, recommence avec cellule suivante.

Voila voila.

Bonne journée a tous!!!

 

[bqtr]

Re : Copier/Coller fichiers externes

Bonsoir Blaise3113,

Voici une façon de faire, il faut cocher la case devant la référence "Microsoft Scripting Runtime" dans le menu Outils/Référence de VBA.

Sub Copie_Fichier()

Dim cell As Range
Dim NomFichier As String
Dim OFSO As Scripting.FileSystemObject
Dim OFLD As Scripting.Folder
Dim OF As Scripting.File

Set OFSO = New Scripting.FileSystemObject
Set OFLD = OFSO.GetFolder("Q:\bilans\Dossier Dep") ' A modifier par ton dossier de départ

  For Each cell In Range("A1:A" & Range("A65536").End(xlUp).Row) ' Plage à modifier
      NomFichier = "TE" & cell & ".dwg"
      Set OF = OFLD.Files(NomFichier)
      OF.Copy "Q:\bilans\Dossier Arr\", True ' A modifier par ton dossier d'arrivée
  Next

Set OFSO = Nothing
Set OFLD = Nothing
Set OF = Nothing

End Sub

Bonne soirée

 

[Blaise3113]

Re : Copier/Coller fichiers externes

Un grand merci a toi, je vas essayer ca de ce pas.

Bonne journée a tous!

 

[Blaise3113]

Re : Copier/Coller fichiers externes

Je confirme, ca marche nikel, j'ai fait quelques adaptations notamment pour rajouter une condition pour qu'il effectue la copie, mais ca fonctionne tres bien. Merci encore!
Salut

 

[Blaise3113]

Re : Copier/Coller fichiers externes

Tant que j'y suis j'en profite, je voulais savoir s'il est possible de rajouter une option telle que s'il ne trouve pas le fichier que l'on cherche, il passe a la suite du prog sans faire de message d'erreur. La c'est vraiment trop corsé pour moi!

Bonne journée a tous!

 

[bqtr]

Re : Copier/Coller fichiers externes

Bonsoir Blaise3113,

Essaye cette modif :

Sub Copie_Fichier()

Dim cell As Range
Dim NomFichier As String
Dim OFSO As Scripting.FileSystemObject
Dim OFLD As Scripting.Folder
Dim OF As Scripting.File

On Error GoTo Erreur
Set OFSO = New Scripting.FileSystemObject
Set OFLD = OFSO.GetFolder("Q:\bilans\Dossier Dep") ' A modifier par ton dossier de départ

  For Each cell In Range("A1:A" & Range("A65536").End(xlUp).Row)
      NomFichier = "TE" & cell & ".dwg"
      Set OF = OFLD.Files(NomFichier)
      OF.Copy "Q:\bilans\Dossier Arr\", True ' A modifier par ton dossier d'arrivée
  Next
  
Erreur:
   If Err.Number = 53 Then MsgBox "Le Fichier :  " & "TE" & cell & ".dwg" & "  n'existe pas", , "Erreur Fichier :"
   Resume Next
 
Set OFSO = Nothing
Set OFLD = Nothing
Set OF = Nothing

End Sub

Si un fichier n'existe pas, une MsgBox t'en avise. Après l'avoir validée, la macro continue.

A+

 

[Blaise3113]

Re : Copier/Coller fichiers externes

Trop fort ca marche encore parfaitement, je l'ai un peu adapté pour qu'il n'affiche pas le message, vu que j'ai un grand nombre de fichiers. Encore merci beaucoup pour cette réponse rapide, claire et efficace!!

A+

 

[pas]

Re : Copier/Coller fichiers externes

Bonjour,

je n'y arrive pas sur excel 2000, ça coince sur :

Set OF = OFLD.Files(NomFichier)

as tu une solution ?
je n' arrive à copier ni avec filecopy, ni avec robocopy