[Tasos]

Καλημέρα!
Φίλε Θοδωρή, σε περιβάλλον Windows δεν μπορείς να χρησιμοποιήσεις τους παρακάτω χαρακτήρες σε ονόματα αρχείων:

\ /  : * ? " < > | 

Γενικότερα, για δημιουργία αντιγράφου ασφάλειας θα πρότεινα τα εξής:

1) έναν πίνακα με το όνομα "tblSettings" με τα πεδία:

• BackupPath ( κείμενο, 255 )
• ID ( αναγνωριστικό, αυτόματη αρίθμηση )

Ο πίνακας πρέπει να περιέχει μια εγγραφή (Γράψε κάτι στο πεδίο BackupPath και αφού αποθηκευτεί η εγγραφή άδειασε το πεδίο).

2) Σε μια λειτουργική μονάδα τον παρακάτω κώδικα:

Option Explicit
Private Const MyPC = 17&
Private Const ShOptions = 65&

Public Function CreateBackup()
    Dim fso As Object, oFile As Object
    Dim BackupFolder As String
    Dim SourcePath As String
    Dim DestinationPath As String
    Dim ext As String
    Dim BaseName As String
    Dim BaseNameLen As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")
    On Error GoTo ErrH
    BackupFolder = Nz(DLookup("BackupPath", "tblSettings", "BackupPath Is Not Null"))
    If Len(BackupFolder) < 1 Then
        BackupFolder = FolderBrowserDialog
        If BackupFolder <> vbNullString Then
            CurrentDb.Execute "UPDATE tblSettings SET BackupPath = '" & BackupFolder & "' WHERE ID Is Not Null"
        Else
            Exit Function
        End If
    End If
    If Not fso.FolderExists(BackupFolder) Then fso.CreateFolder BackupFolder
    If Right(BackupFolder, 1) <> "\" Then BackupFolder = BackupFolder & "\"
    SourcePath = CurrentProject.FullName
    BaseName = fso.GetBaseName(SourcePath)
    BaseNameLen = Len(BaseName)
    ext = fso.GetExtensionName(SourcePath)
    DestinationPath = BackupFolder & BaseName & Replace(Format(Now, "_dd_mm_yy__hh:mm:ss."), ":", "_") & ext
    fso.CopyFile SourcePath, DestinationPath, True
    For Each oFile In fso.GetFolder(BackupFolder).Files
        If Left(fso.GetBaseName(oFile.Path), BaseNameLen) = BaseName Then
            If fso.GetExtensionName(oFile.Path) = ext Then
                If oFile.DateCreated < (Now - 3) Then  '  3=  αρχείο που δημιουργήθηκε 3 ημερες 
                                                                        'πριν. Μπορεί να προσαρμοστεί.
                    fso.DeleteFile oFile, True
                End If
            End If
        End If
    Next
ErrH:
    If Err > 0 Then MsgBox Err & vbLf & Err.Description
End Function


  
Public Function FolderBrowserDialog() As String
      Dim oShell As Object
      Dim oFolder As Object
      Set oShell = CreateObject("Shell.Application")
      Set oFolder = oShell.BrowseForFolder( _
              hWndAccessApp, "Επιλέξτε φάκελο για να δημιουργήσετε  αντίγραφο ασφαλείας." & vbLf & _
              "αυτής της εφαρμογής και πατήστε 'ΟΚ'." & vbLf & _
              "Πατήστε 'Ακυρο'για να κλείσετε την εφαρμογή χωρίς αντίγραφο ασφαλείας." _
              & vbLf, ShOptions, MyPC)
      If Not oFolder Is Nothing Then
          FolderBrowserDialog = oFolder.Self.Path
      End If
      Set oFolder = Nothing
      Set oShell = Nothing
  End Function

Ο παραπάνω κώδικας παίρνει τη διαδρομή του φακέλου με τα αντίγραφα ασφάλειας από τον πίνακα "tblSettings".

Αν ο πίνακας "tblSettings" δεν περιέχει τιμή τότε δίνεται η δυνατότητα στο χρήστη να επιλέξει έναν φάκελο ο οποίος θα αποθηκευτεί (στον πίνακα) για να χρησιμοποιηθεί μελλοντικά.

Επίσης αντίγραφα που δημιουργήθηκαν 3 ημέρες πριν από την νεότερο αντίγραφο διαγράφονται.

Η συνάρτηση CreateBackup() μπορεί να κληθεί από οποιοδήποτε σημείο της εφαρμογής.

Τάσος