Copier Fichier(s) et Ecraser

[franck17]

Bonsoir le Forum

Voila ma question,j'utilise le code suivant pour copier des fichiers d'un repertoire vers un autre.Est il possible a la fin du code de rajouter une MsgBox
pour demander si les fichiers sont deja present dans le repertoire destination si ont veux les ecraser ou pas.

Sub Test1()
Dim Fichiers As Variant
Dim i As Integer
Dim Chemin As String
Dim Fso As Object
ChDir (UserForm4.TextBox1)
'Sélection des fichiers
Fichiers = Application.GetOpenFilename(, , , , True)
If IsArray(Fichiers) = False Then MsgBox "aucun fichier sélectionné", vbOKOnly + vbCritical, "fin de procédure ": Exit Sub
'--- Sélection repertoire ---
Chemin = UserForm4.TextBox2
If Chemin = "" Then Exit Sub
Set Fso = CreateObject("Scripting.FileSystemObject")
'Transfert fichiers
For i = 1 To UBound(Fichiers)
Fso.CopyFile Fichiers(i), Chemin, True
Next
MsgBox "Opération terminée"
UserForm4.TextBox1.Value = ""
UserForm4.TextBox2.Value = ""

Unload UserForm4
End Sub

Merci pour votre aide

 

[MichelXld]

Re : Copier Fichier(s) et Ecraser

bonjour Franck


J'espère que cette adaptation répondra à ta demande

        Dim Reponse As String
        Dim Cible As Object
        
        '
        '
        '
        '
        
        For i = 1 To UBound(Fichiers)
            
            Set Cible = Fso.GetFile(Fichiers(i))
            
            'Vérifie si le fichier existe deja dans le classseur destination
            If Dir(Chemin & "\" & Fso.GetFileName(Cible)) <> "" Then
            
                Reponse = MsgBox("Le fichier '" & Fso.GetFileName(Cible) & _
                "' existe déja dans le répertoire " & vbCrLf & "'" & Chemin & "'" & _
                vbCrLf & vbCrLf & "Voulez l'écraser?", vbYesNo)
                
                If Reponse = vbYes Then _
                    Fso.CopyFile Fichiers(i), Chemin & "\", True
            Else
                Fso.CopyFile Fichiers(i), Chemin & "\", True
            End If
        
            Set Cible = Nothing
        
        Next i

Bonne journée
MichelXld

 

[franck17]

Re : Copier Fichier(s) et Ecraser

Bonjour Michel

Je te remercie pour ta réponse qui fonctionne parfaitement et je te souhaite de bonnes fetes de fin d'année.

Encore Merci et vive le Forum