[ Active X Controls ] Access Backup

[jimrenoir]

Παιδια καλημέρα και καλό χειμώνα σε όσους έχουν γυρίσει.
Θα ήθελα λίγη βοήθεια.Φτιάχνω μια βάση απλή για καταγραφή ασθενών.Αυτό που θέλω είναι κάθε φορά που πιέζω το πλήκτρο εχιτ (χ)-κλείνει την βάση,(να γίνεται και απευθείας και αποθήκευση σε εξωτερικό δίσκο-usb-να με ρωτάει πού θα το αποθηκεύση και σαν όνομα να την βάζει την ημερομηνία της ημέρας).Δηλαδή με το πάτημα του να κλείνει την βάση και να με ρωτάει που θέλω να κάνω το backup. ενοείτε πως θα διατηρείτε και στον σκληρό δίσκο χωρίς όμως να αλάζει όνομα(αυτό γίνεται ούτως η άλλως.
Παράκληση μην το σώσετε σε νεότερη μορφή από ότι είναι γιατι δεν θα μπορώ να το ανοίξει στην εργασία μου.
Ευχαριστώ εκ των προτέρων.

[Tasos]

Καλησπέρα Δημήτρη!
1) Δημιούργησε μια κενή φόρμα και αποθήκετσε την ως HiddenForm (παραδειγματικό όνομα).

Kατόπιν δημιούργησε μια μακροεντολή (καρτέλα Δημιουργία > Μακροεντολή) με το όνομα AutoExec.

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

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

MacroEdit.png

Με τη μέθοδο αυτή, η φόρμα HiddenForm θα ανοίγει με την εκκίνηση της εφαρμογής, θα είναι κρυφή και θα κλείνει όταν κλείνει η εφαρμογή.

Κατόπιν στις ενεργοποίησε την καρτέλα Συμβάντα στο φύλλο ιδιοτήτων της φόρμας.

Επέλεξε την επιλογή "Με τη φόρτωση"

Επέλεξε "[Διαδικασία συμβάντος]" και πάτησε το κουμπί μετά από το DropDown.

Θα εμφανιστεί το παράθυρο του VBE με τον ακόλουθο κώδικα:

Private Sub Form_Load()

End Sub

Ανάμεσα σ αυτές τις 2 γραμμές πρόσθεσε αυτό: MsgBox "Welcome!"
έτσι θα έχεις:

Private Sub Form_Load()
MsgBox "Welcome!"
End Sub

Εξυπηρετεί μόνο και μόνο για να ξέρεις κατά την ανάπτυξη της εφαρμογής ότι μακροεντολή AutoExec λειτούργησε κατά την έναρξη της εφαρμογής και η φόρμα έχει φορτωθεί.
Αργότερα μπορείς να διαγράψεις τις 3 αυτές γραμμές.


Κατόπιν από το φύλλο ιδιοτήτων επέλεξε την επιλογή "Με τη αποφόρτωση".

Επέλεξε πάλι "[Διαδικασία συμβάντος]" και πάτησε το κουμπί μετά από το DropDown.

Ο κέρσορας θα βρίσκεται ανάμεσα στις γραμμές:

Private Sub Form_Unload(Cancel As Integer)

End Sub

Αντικατέστησε τις με:

Private Sub Form_Unload(Cancel As Integer)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim BackupFolder As String
    Dim SourcePath As String
    Dim DestintionPath As String
StartHere:
    BackupFolder = FolderBrowserDialog
    If BackupFolder <> vbNullString Then
        If Right(BackupFolder, 1) <> "\" Then BackupFolder = BackupFolder & "\"
        SourcePath = CurrentProject.FullName
        DestintionPath = BackupFolder & Right(SourcePath, InStr(1, StrReverse(SourcePath), "\") - 1)
        If SourcePath <> DestintionPath Then
            fso.CopyFile SourcePath, DestintionPath, True
        Else
            MsgBox "Δεν μπορείτε να αποθηκεύσετε αντίγραφο ασφαλείας στον φάκελο που βρίσκεται η εφαρμογή!" & vbLf & _
                    "Επιλέξτε άλλη διαδρομή ή δημιουργήστε νέο φάκελο.", vbExclamation
            DestintionPath = vbNullString
            BackupFolder = vbNullString
            GoTo StartHere
        End If
    End If
    MsgBox "Bye!"
End Sub 

Ο κώδικας αυτός, όπως υποδηλώνει και το όνομα του, τρέχει όταν αποφορτώνεται η φόρμα
και εμφανίζει ένα διάλογο επιλογής του φακέλου που θα φιλοξενήσει το αντίγραφο ασφαλείας.

Αν ο χρήστης δεν επιθυμεί αντίγραφο ασφαλείας μπορεί να πατήσει το πλήκτρο ESC ή το κουμπί του διαλόγου "Άκυρο" και να παρακάμψει το διάλογο και να κλείσει την εφαρμογή

Στην κορυφή της σελίδας του VBE κάτω από την πρώτη γραμμη ("Option Compare Database")
πρόσθεσε την παρακάτω συνάρτηση:

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

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

Αποθήκευσε, κάνε επανεκκίνηση στην εφαρμογή σου και δοκίμασε.

Φιλικά

Τάσος

[mike04]

Τάσο καλημέρα.
Πολύ χρήσιμο το παράδειγμά σου αλλά πώς θα μπορούσε να προσαρμοστεί όταν έχουμε δύο βάσεις δεδομένων δηλαδή στην μία υπάρχουν μόνο οι πίνακες και στην άλλη οι φόρμες – εκθέσεις – ερωτήματα και συνδέονται μεταξύ τους με σύνδεση πινάκων. Εμείς σε αυτή την περίπτωση θέλουμε αντίγραφο μόνο των πινάκων. Σημειώνω ότι η εφαρμογή μου τρέχει σε δίκτυο και έτσι πρέπει οι πίνακες να είναι ξεχωριστά από τα υπόλοιπα ώστε να μπορούν να εργάζονται ταυτόχρονα δύο και περισσότερα άτομα.
Αν υπήρχε λύση θα με βοηθούσε αρκετά.
Ευχαριστώ.

[Tasos]

Καλημέρα Μιχάλη!

Θα πρέπει να γίνουν κάποιες αλλαγές στον κώδικα του συμβάντος Form_Unload() στο προηγούμενο μου μήνυμα.

Τροποποίησε λοιπόν την πρώτη γραμμή του κώδικα

από: Dim fso As Object

σε: Dim fso As Object, tdf As DAO.TableDef

Επίσης αντικατέστησε τη γραμμή: SourcePath = CurrentProject.FullName

με τον παρακάτω κώδικα:

        For Each tdf In CurrentDb.TableDefs
            If Left(tdf.Connect, 9) = ";DATABASE" And Left(tdf.Name, 3) <> "Sys" Then
                SourcePath = Mid(tdf.Connect, 11, 256)
                Exit For
            End If
        Next
        'If SourcePath = vbNullString Then
           ' SourcePath = CurrentProject.FullName
       ' End If 

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

Τάσος

[mike04]

Τάσο καλησπέρα και ευχαριστώ για την απάντησή σου.
Έκανα αυτό που μου γράφεις αλλά δεν τα κατάφερα.
Κατά την έξοδο από την βάση παίρνω το εξής μήνυμα :
Compile error:
User defined tupe not defined
Το ξέρω ότι ζητάω πολλά αλλά αν μπορούσες ας μου έδινες τον τροποποιημένο κώδικα γιατί μάλλον κάτι κάνω λάθος.
Και πάλι ευχαριστώ.

[Tasos]

Καλησπέρα Μιχάλη!

Δεν έχω την παραμικρή πληροφορία για το έργο σου και έτσι δεν μπορώ να σου δώσω κάποια συγκεκριμένη απάντηση.

Το μήνυμα σφάλματος υποδηλώνει ότι δεν έχεις δηλώσει κάποια μεταβλητή
(ίσως την "tdf As DAO.TableDef")
ή
η βιβλιοθήκη DAO x.x δεν έχει προστεθεί στις αναφορές (μάλλον το δεύτερο ισχύει).

Έλεγξε στο μενού Tools>Referemces αν η DAO x.x είναι τσεκαρισμένη.

Αν δεν διορθωθεί το πρόβλημα θα πρέπει να ανεβάσεις ένα παράδειγμα που θα μας επιτρέπει να επισημάνουμε την αιτία του προβλήματος.

Φιλικά

Τάσος

[mike04]

Τάσο καλημέρα.
Όντος δεν είχα προσθέσει στις αναφορές την DAO.xx
Το έκανα και όλα καλά.
Και πάλι ευχαριστώ

[SIERRA1]

Καλησπέρα σε σε όλους.
Τάσο για μία ακόμα φορά... απλά τρομερός... μπράβο !!!
Σχετικά με το backup έχω και εγώ δύο ερωτήσεις.

1. Μπορούμε και με πιο τρόπο στο αρχειό backup να έχουμε ημερομηνία που πήραμε το backup και ακόμα καλύτερα και κάποιον αριθμό.
παράδειγμα :
................15/10/2011-1.accdb
................17/10/2011-1.accdb
................18/10/2011-1.accdb
................18/10/2011-2.accdb
................18/10/2011-3.accdb
................20/10/2011-1.accdb
και πάει λέγοντας (όπου τελείες το όνομα της βάσης).
Αυτό χρειάζεται ώστε να κρατάω όλα τα backup όσα και να έχουν γίνει ακόμα και δύο ή και περισσότερα την ίδια ημέρα και να μπορώ να χρισιμοποιήσω όποιο θέλω.
(δηλ. να αποφοίγω το χειροκίνητο τρόπο να παω στη τοποθεσία που έχω κάνει το backup και να το μετονομάζω κάθε φορά, γιατί άμα το ξεχάσεις το τελευταίο backup που θα πάρεις θα γραφτεί πάνω στο προηγούμενο.

2. Αν θυμάσε πρίν λίγο καιρό σε είχα απασχολίσει σε αυτό το θέμα: [ Ασφάλεια] Κλείδωμα κώδικα VBA & SQL σε access 2010 και μου είχες δώσει τη λύση.
Εγώ έγω διαιρερεμένη τη βάση και δε δουλέυει σε δίκτυο όπως του Μιχάλη (χρόνια του πολλά λόγω της γιορτής του) πρέπει να κάνω και εγώ το ίδιο που του προτείνεις στο post #6 ή όχι ;

Ευχαριστώ !!!

[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() μπορεί να κληθεί από οποιοδήποτε σημείο της εφαρμογής.

Τάσος

[SIERRA1]

Καλησπέρα στο Forum.
Τάσο ευχαριστώ για την άμεση απάντηση.
Αυτονόητο είναι ότι αντί για κάθετες θα χρησιμοποιούσα (_) αλλά από ανοησία μου έβαλα κάθετες. Συγνώμη.
Δημιούργησα στη βάση που έχω, έναν ακόμη πίνακα όπως μου είπες (όνομα πίνακα και πεδία).
Μετά δημιούργησα μια λειτουργική μονάδα και έβαλα τον κώδικα που μου έδωσες και την αποθήκευσα με το όνομα module1 αλλά δεν είδα αποτέλεσμα.

Ξεκίνησα και έκανα μια βάση από την αρχή με μόνο το πίνακα και τη λειτουργική μονάδα που μου πρότεινες για να δω αν μπαινω στη διαδικασία αποθηκευσης της βάσης (δηλ. μου βγάζει κάποιο παράθυρο που να μου προτείνη διαδρομή αποθηύσης αλλά πάλι δεν καταφερα κάτι.
Τάσο θα το ξάναδοκιμάσω με περισσότερη προσοχή.
Ευχαριστώ και πάλι.