Aide sur macro deplacement fichiers

sri75

XLDnaute Occasionnel
Bonjour, j'ai adapté cette macro pour pouvoir déplacer tous les fichiers d'un répertoire sous windows, avec une gestion d'erreur si le fichier existe déja dans le répertoire de destination.

Dans mon module de gestion d'erreur j'ai une erreur 58 à la ligne fso.MoveFile origine & Monfichier, destination & Monfichier

alors que normalement l'erreur 58 est gérée. Si j'ai 5 fichiers, pour la première gestion d'erreur c'est ok mais c'est quand je passe au deuxième fichier que ca plante.

Merci pour vos conseils.








Sub copieecrasante2()


Dim fso As Object, origine As String
Dim destination As String, reponse As Integer
Dim sortie As Byte, message As String
On Error GoTo camarchepas

debut:


origine = "c:\toto\"
destination = "c:\titi\"


Monfichier = Dir(origine & "*.*")

If Monfichier <> "" Then




'Ca plante à la ligne du dessous"

Set fso = CreateObject("scripting.filesystemobject")

fso.MoveFile origine & Monfichier, destination & Monfichier

GoTo debut


Exit Sub
camarchepas:
Select Case Err
Case 58
message = "Le fichier " & destination & " existe déjà" & _
vbNewLine & "Désirez vous le supprimer?"
reponse = MsgBox(message, vbQuestion + vbOKCancel, "Erreur")
Select Case reponse
Case vbOK
Kill destination & Monfichier
fso.MoveFile origine & Monfichier, destination & Monfichier
Case Else
sortie = 1
End Select
Case 53
message = "Le fichier " & origine & " n'existe pas" & _
vbNewLine & "Fin du programme"
MsgBox message
Case Else
End Select


GoTo debut

End If

End Sub
 

Discussions similaires


Haut Bas