Daily Backup of BE Database (1 Viewer)

[RaptorRaptur]

for automatic backup whenever the front-end is closed, you will need a startup, hidden form that when closed will
do the backup.
copy this to a module:

Function IsBackendInUse() As Boolean
    Dim strBackendPath As String
    Dim intFileNum As Integer
   
    strBackendPath = BackEndPath()
   
    On Error Resume Next
    intFileNum = FreeFile
    Open strBackendPath For Binary Access Read Lock Read Write As #intFileNum
    Close #intFileNum
   
    If Err.Number <> 0 Then
        IsBackendInUse = True  ' File is locked
    Else
        IsBackendInUse = False ' File is available
    End If
    On Error GoTo 0
End Function

Public Sub BackupBackendDatabase()
    Dim strSourcePath As String
    Dim strBackupPath As String
    Dim strBackupFileName As String
   
    ' change this to the correct path to your backup folder
    strBackupPath = Environ("userprofile") & "\documents\backup\"
   
    ' Path to your backend database
    strSourcePath = BackEndPath()
   
    ' Backup location with timestamp
    'strBackupFileName = GetBaseName(strSourcePath) & "_" & Format(Now(), "yyyy-mm-dd_hhnnss") & "." & GetExtension(strSourcePath)
    Dim strBaseName As String
    strBaseName = GetBaseName(strSourcePath)
    If Right(strBaseName, 3) = "_be" Then
        strBackupFileName = Left$(strBaseName, Len(strBaseName) - 3) & Format$(Date, "mmm") & "_be"
    Else
        strBackupFileName = GetBaseName(strSourcePath) & Format$(Date, "ddd")
    End If
    strBackupFileName = strBackupFileName & "." & GetExtension(strSourcePath)
   
   
    ' Create backup folder if it doesn't exist
    If Dir(strBackupPath, vbDirectory) = "" Then
        MkDir strBackupPath
    End If
    strBackupPath = strBackupPath & strBackupFileName
   
    ' Copy the backend database
    On Error Resume Next
    FileCopy strSourcePath, strBackupPath
   
    If Err.Number = 0 Then
        MsgBox "Backup created successfully: " & strBackupFileName, vbInformation
    Else
        MsgBox "Backup failed: " & Err.Description, vbExclamation
    End If
    On Error GoTo 0
End Sub


Public Function BackEndPath$()
Const conString = ";DATABASE="
Dim td As DAO.TableDef
Dim db As DAO.Database: Set db = CurrentDb
Dim conn$
For Each td In db.TableDefs
    conn = td.Connect
    If Len(conn) <> 0 Then
        If InStr(1, conn, conString) = 1 Then
            BackEndPath = Mid$(conn, Len(conString) + 1)
            Exit For
        End If
    End If
Next
Set td = Nothing: Set db = Nothing
End Function


' helper
Function GetFileName(strPath As String) As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    GetFileName = fso.GetFileName(strPath)
    Set fso = Nothing
End Function

Function GetExtension(strPath As String) As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    GetExtension = fso.GetExtensionName(strPath)
    Set fso = Nothing
End Function

Function GetBaseName(strPath As String) As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    GetBaseName = fso.GetBaseName(strPath)  ' Filename without extension
    Set fso = Nothing
End Function

now add code to the Close Event of your hidden, start-up form:

Private Sub Form_Close()
    If IsBackendInUse() Then
        MsgBox "Backup skipped - other users are currently accessing the database.", vbInformation
        Exit Sub
    End If

    Call BackupBackendDatabase
End Sub

What if there are multiple users and therefore many Front Ends

 

[RaptorRaptur]

Thanks, I really should have read the code properly before posting. Sorry All

 

[Pete490h]

Always be sure to double check with your IT department to ensure they don't already have the file server backed up.
If they do, you might be able to right click the folder, go to Properties, then Previous Versions, and see days or weeks worth of backed up files / folders there at any given time. The backing up of data usually belongs to the IT dept and should be left up to them, IMHO. I mean, if such is the case.
I say this only because various times I've made the mistake of dumping a lot of time into backing things up and then realized the company already had such a robust process in place that mine was totally unnecessary

Yes it does a daily backup, however it overwrites the following day….