Autobackup naszej aplikacji

Wielokrotnie zdarzało mi się utworzyć dla klienta skoroszyt Excela do którego codziennie dodaje nowe dane. Skoroszyt taki będzie używany przez wiele lat i każdego dnia będą dodawane nowe rekordy. Dla usprawnienia pracy dodałem kilka prostych makr, które automatyzują pewne czynności (np. automatycznie kopiują zaznaczone wiersze z głównej tabeli do innych tabelek w pozostałych arkuszach).

Wskazówka: zamieszczam też bliźniaczy moduł dla Accessa

Niestety, ale zawsze istnieje ryzyko, że coś się zepsuje (na skutek jakiegoś losowego błędu makro mogłoby coś zepsuć, albo zwyczajnie zadziała złośliwość rzeczy martwych i plik z danymi się uszkodzi).

Dlatego też napisałem proste makro, które automatycznie się wykonuje podczas otwierania skoroszytu. To makro sprawdza, czy danego dnia była wykonywana kopia pliku i jeśli kopia nie została wykonana, to ją robi w folderze np. c:\kopie\ – ścieżka do folderu z kopiami jest zdefiniowana w stałej o nazwie BACKUP_FOLDER, której deklaracja znajduje się na początku moduły)

Rozwiązanie ma dodatkową zaletę: jeśli pracownik coś zepsuje (świadomie lub nieświadomie) to zawsze można wrócić do „wczorajszego” pliku.

Dodatkowo dodałem możliwość wykonania backupu na żądanie (np. gdy wiemy, że danego dnia wprowadziliśmy dużo nowych rekordów i wiemy że za chwilę będziemy wykonywać jakieś operacje, które mogłyby uszkodzić nasze dane). Aby to zrobić należy wywołać funkcję MakeBackup z parametrem True.

Oto uproszczony algorytm działania modułu

1. Procedura Auto_Open automatycznie zostanie uruchomiona w momencie tworzenia skoroszytu (jeśli w aplikacji jest kilka modułów i w jakimś innym już jest procedura Auto_Open to musisz z mojego modułu tę procedurę skasować i przenieść wywołanie funkcji MakeBackup na początek tamtej procedury gdyż w jednym projekcie może być tylko jedna procedura Auto_Open).
2. Sprawdzamy czy stała BACKUP_FOLDER nie jest pusta. Jeśli jest pusta to wyświetlamy ostrzeżenie i kończymy działanie (nie można wykonać kopii jak nie wiemy do jakiego folderu kopiujemy plik)
3. Sprawdzamy czy w nazwie pliku jest ciąg znaków „kopia”. Jeśli tak to znaczy, że ktoś otworzył plik z kopią a nie właściwą aplikację, więc opuszczamy funkcję gdyż nie chcemy robić kopii kopii.
4. Sprawdzamy, czy folder z backupami (jego nazwa powinna być zdefiniowana w stałej BACKUP_FOLDER) istnieje. Jeśli nie to funkcja kończy swoje działanie
5. Generujemy nazwę pliku z kopią w formacie: ścieżka do backupów + rdzenna nazwa pliku + słowo kopia + dzisiejsza data + rozszerzenie pliku (w przypadku parametru NaZadanie=True dodatkowo do daty dodajemy godzinę z minutami i sekundami).
6. Sprawdzamy czy plik istnieje. Jeśli tak, to znaczy, że tego dnia był już zrobiony autobackup i opuszczamy funkcję.
7. Wykonujemy kopię pliku
8. Ustawiamy dla pliku z kopią atrybut tylko do odczytu, aby osoba, która otworzy plik z kopią (w celu np. odzyskania utraconych informacji) nie nadpisała pliku z backupem.
9. Funkcja kończy swoje działanie. Nie informuje o wykonaniu backupu (jak chcesz możesz na końcu kodu dodać instrukcję MsgBox) gdyż chciałem, aby autobackup był cichy (nie wkurzał zbędnymi komunikatami za każdym razem, gdy plik z aplikacją został otworzony)

W przypadku Accessa kod jest podobny do tego Excelowego ale jest kilka kosmetycznych różnic. Największa z nich wynika z faktu iż Access niestety ale nie wykonuje procedury Auto_Open przy starcie aplikacji dlatego wywołanie funkcji MakeBackup należy umieścić np. w kodzie zdarzenia Form_Load formularza, który automatycznie jest ładowany wraz ze startem aplikacji.

Pobierz przykładowy plik (aplikacja + wyeksportowany moduł)

Oto kod z modułu modAutoBackupExcel (kod dla Accessa umieściłem w archiwum, które jest do pobrania):

' (c) Damian Daszkiewicz 2024
' https://www.kursVBA.pl
' https://www.OfficeBlog.pl
'
' Moduł wykonuje autobackup aplikacji

Option Explicit

'ustaw tutaj folder gdzie będa każdego dnia wykonywane kopie np. c:\kopie\
Public Const BACKUP_FOLDER = "c:\kopie\"

' przy otworzeniu skoroszytu odpal automatycznie funkcję do tworzenia backupu
Sub Auto_Open()
    Dim Z As Boolean
    Z = MakeBackup
    
    ' Tutaj dodaj jakąś awaryjną procedurę jeśli backup się nie wykonał
    If Z = False Then
        MsgBox "Backup się nie wykonał", vbExclamation, "!!! AWARIA !!!"
    End If
End Sub

' obsługa kliknięcia w przycisk Utwórz backup na żądanie
Sub BackupNaZadanie()
    Dim Z As Boolean
    Z = MakeBackup(True)
        
    If Z = False Then
        MsgBox "Backup się nie wykonał", vbExclamation, "!!! AWARIA !!!"
    End If
End Sub

' Główna funkcja wykonująca kopię bezpieczeństwa
Function MakeBackup(Optional NaZadanie As Boolean = False) As Boolean
    On Error GoTo MakeBackup_Error
    Dim pos As Long
    Dim Folder As String
    Dim Plik As String, Rozszerzenie As String
    
    'Odczytaj z ustawień ścieżkę do folderu z backupami
    Folder = BACKUP_FOLDER
    
    ' Sprawdź czy folder istnieje
    If Trim(Folder) = "" Then
        MsgBox "Backup nie został wykonany, gdyż w ustawieniach nie została " + _
            "podana ścieżka do katalogu z backupami", vbExclamation
        Exit Function
    End If
    
    ' Jeśli w nazwie otwieranego (tego) skoroszytu jest ciąg znaków kopia to znaczy, że
    ' uzytkownik otworzył plik kopii a nie plik produkcyjny więc nie tworzymy backupu pliku z kopią
    If InStr(LCase(ThisWorkbook.Name), "kopia") > 0 Then
        Exit Function
    End If
            
    If Right$(Folder, 1) <> "\" Then Folder = Folder + "\"
    If FolderExists(Folder) = False Then
        MsgBox "Folder: " + Folder + " nie istnieje. Backup NIE został wykonany", vbExclamation
        Exit Function
    End If
    
    
    ' === Wygeenruj nazwę pliku z kopią ===
    Plik = ThisWorkbook.Name
    
    'utnij rozszerzenie z nazwy
    pos = InStrRev(Plik, ".")
    Rozszerzenie = ""
    If pos > 0 Then
        Rozszerzenie = Mid$(Plik, pos + 1)
        Plik = Left$(Plik, pos - 1)
    End If
    
    If NaZadanie = False Then
        ' Zwykły automatyczny autobackup z datą w nazwie pliku
        Plik = Folder + Plik + " [KOPIA] " + Format(Date, "yyyy-mm-dd") + "." + Rozszerzenie
    Else
        'backup wywołany NA ŻADANIE użytkownika, w nazwie dodajmy też godzinę wykonania backupu
        Plik = Folder + Plik + " [KOPIA] " + Format(Now, "yyyy-mm-dd hh.mm.ss") + "." + Rozszerzenie
    End If
        
    ' Jeśli nie istnieje jeszcze plik dzisiejszą datą w nazwie to wykonaj kopię
    If FileExists(Plik) = False Then
        Application.ActiveWorkbook.SaveCopyAs Filename:=Plik
        SetAttr Plik, vbReadOnly 'Ustaw atrybut tylko do odczytu
    End If
    
    MakeBackup = True
MakeBackup_Error2:
    Exit Function

MakeBackup_Error:

    MsgBox Err.Description, vbExclamation, "MakeBackup"
    Resume MakeBackup_Error2

End Function


Public Function FileExists(fname) As Boolean
    On Error GoTo FileExists_Error
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FileExists = FSO.FileExists(fname)
    
FileExists_Error2:
    Exit Function

FileExists_Error:
    MsgBox Err.Description, vbExclamation, "FileExists"
    Resume FileExists_Error2:
End Function


Function FolderExists(fname)
    On Error GoTo FolderExists_Error
    Dim FSO As Object
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FolderExists = FSO.FolderExists(fname)
    
FolderExists_Error2:
    Exit Function

FolderExists_Error:
    MsgBox Err.Description, vbExclamation, "FolderExists"
    Resume FolderExists_Error2:
End Function