[VBA] Δημιουργία Backup πολλών αρχείων

[Tasos]

Γεια σας!
Φίλε Μανώλη, έκανα κάποιες διορθώσεις στο παράδειγμα του προηγούμενου μηνύματος μου .
Δες το και προσανατολίσου στις τεχνικές που εφαρμόζονται.

Στο τελευταίο σου ερώτημα:

Ο παρακάτω κώδικας με ελάχιστες προσαρμογές πιστεύω ότι θα σε βοηθήσει.

Πριν τρέξεις τον κώδικα αυτό, πήγαινε στον VBE στο μενού Tools>References, βρες και τσέκαρε την επιλογή "Microsoft Scripting Runtime".

Option Explicit
Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
                                             ByVal lpPath As String) As Long


Sub test()
    Dim c As Range, NewFileName As String
    Dim fso As New Scripting.FileSystemObject
    For Each c In Range("A2:A100")
        If Not IsEmpty(c) Then
            If fso.FileExists(c.Text) Then
                If Not fso.FolderExists(c.Offset(, 1).Text) Then MakeSureDirectoryPathExists c.Offset(, 1).Text
                If fso.FolderExists(c.Offset(, 1).Text) Then
                    NewFileName = Replace(c.Offset(, 1) & "\" & Mid$(c, InStrRev(c, "\") + 1), "\\", "\")
                    If Left(NewFileName, 1) = "\" Then NewFileName = "\" & NewFileName
                    fso.CopyFile Source:=c.Text, Destination:=NewFileName, OverWriteFiles:=True ' Αντιγραφή 
                    ' fso.MoveFile Source:=c.Text, Destination:=NewFileName ' Μεταφορά
                Else
                    '.....Ο φάκελος προορισμού δεν υπάρχει και ούτε πορεί να δημιουργηθεί
                End If
            Else
                '.......Το αρχείο/ πηγή δεν υπάρχει
            End If
        End If
    Next

End Sub

Καλή συνέχεια!

Τάσος