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
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