Databack backup script (1 Viewer)

soap

Registered User.
Local time
Yesterday, 19:02
Joined
Nov 4, 2018
Messages
25
Hi
Please i need VBA script for my database backup.
Thanks
 

Gasman

Enthusiastic Amateur
Local time
Today, 03:02
Joined
Sep 21, 2011
Messages
7,478
Here is something I use from the switchboard form

HTH

Code:
Function GetAccessBE_PathFilename(pTableName As String) As String
'strive4peace

   ' RETURN
   '  the file path and file name of the BE database
   '  "" if the table is not linked
   
   On Error GoTo Proc_Err
   
   Dim db As DAO.Database _
      , tdf As DAO.TableDef
   
   GetAccessBE_PathFilename = ""
   
   Set db = CurrentDb
   Set tdf = db.TableDefs(pTableName)
   
   If Len(tdf.Connect) = 0 Then
      GoTo Proc_Exit
   End If
   
   ' look at Connect string - Database Type is the first thing specified
   ' if the BE is Access
   If InStr(tdf.Connect, ";DATABASE=") <> 1 Then
      GoTo Proc_Exit
   End If
   
   GetAccessBE_PathFilename = Mid(tdf.Connect, 11)
    
Proc_Exit:
   On Error Resume Next
   Set tdf = Nothing
   Set db = Nothing
   Exit Function
  
Proc_Err:
   MsgBox Err.Description, , _
        "ERROR " & Err.Number _
        & "   GetAccessBE_PathFilename"

   Resume Proc_Exit
   Resume
             
End Function
Sub CreateBackup(Optional strDBType As String)
    Dim strDBpath As String, ext As String, tmp As String
    Dim strPath As String, strBackupPath As String, strDB As String
    
    
    'tmp = CurrentDb.Name    'or maybe this should be the name of your BE
    'strDBType = "FE"
    strDBpath = GetAccessBE_PathFilename("tbl-version_fe_master")
    strPath = Left(strDBpath, InStrRev(strDBpath, "\"))
    strBackupPath = strPath & "Backup\"
    
    'Will now backup front and back end database
    If strDBType = "FE" Then
        strDBpath = CurrentDb.Name
    End If
    strDB = Right(strDBpath, Len(strDBpath) - InStrRev(strDBpath, "\"))
    
    With CreateObject("Scripting.FileSystemObject")
        'ext = "." & .GetExtensionName(tmp)
        tmp = strBackupPath & Format(Now(), "yyyymmdd_hhnnss") & "_" & strDB
        .CopyFile strDBpath, tmp
    End With
    MsgBox strDBType & " Database saved as " & tmp
    
    
End Sub

Function CreateBackupFE()
' Have to do it this way as Switchboard does not allow parameters.
CreateBackup ("FE")
End Function
Function CreateBackupBE()
' Have to do it this way as Switchboard does not allow parameters.
CreateBackup ("BE")
End Function
Public Function GetBackEndPath() As String
On Error GoTo Err_Handler
    Const Attached = dbAttachedTable Or dbAttachedODBC
    Dim dbs As Database
    Dim tbl As TableDef
    Set dbs = DBEngine(0)(0)
    For Each tbl In dbs.TableDefs
        ' Gets the back end full path
        Debug.Print tbl.Name
        Debug.Print tbl.Connect
        If (tbl.Attributes And Attached) <> 0 And Left(tbl.Connect, 10) = ";DATABASE=" Then
            GetBackEndPath = Mid(tbl.Connect, 11, Len(tbl.Connect) - 10)
            Exit For
        End If
    Next

    Set dbs = Nothing
    Set tbl = Nothing
    
Exit_Handler:
    Exit Function

Err_Handler:
    MsgBox (Err.Number & " " & Err.Description & " " & "SelectAll()")
    Resume Exit_Handler
    
End Function
 

Solo712

Registered User.
Local time
Yesterday, 22:02
Joined
Oct 19, 2012
Messages
765
Hi
Please i need VBA script for my database backup.
Thanks

Hi, this is what I use for automated backup. It automatically copies the database file to a directory above the where the app sits. It has a date stamp to distinguish between files. You can write your dialog code around it if you want or put it on a timer to execute every so often.
Code:
Public Sub Backup()
   Dim srcepath As String, destpath As String
  
   srcepath = Application.CurrentProject.path & "\" & Application.CurrentProject.Name
   destpath =  Application.CurrentProject.path & "\Backups\" & _ 
   Format(Now, "YYYY-MM-DD HHMMSS") & "_" & Application.CurrentProject.Name
   '
   On Error GoTo Err_Backup
   '
   FileCopy srcepath, destpath
  
   'MsgBox "Database successfully backed up ! ", vbInformation
Bckup_Exit:
   Exit Sub
Err_Backup:
   MsgBox " Backup failed ! -> " & Err.Number & "-" & Err.Description
   Resume Bckup_Exit
End Sub
'------------------------------------------------------------
Public Sub FileCopy(Srce As String, Dest As String)
  Dim fs As Object
 
  Set fs = CreateObject("Scripting.FileSystemObject")
  fs.CopyFile Srce, Dest
  Set fs = Nothing
End Sub

Best,
Jiri
 

soap

Registered User.
Local time
Yesterday, 19:02
Joined
Nov 4, 2018
Messages
25
Hi, this is what I use for automated backup. It automatically copies the database file to a directory above the where the app sits. It has a date stamp to distinguish between files. You can write your dialog code around it if you want or put it on a timer to execute every so often.
Code:
Public Sub Backup()
   Dim srcepath As String, destpath As String
  
   srcepath = Application.CurrentProject.path & "\" & Application.CurrentProject.Name
   destpath =  Application.CurrentProject.path & "\Backups\" & _ 
   Format(Now, "YYYY-MM-DD HHMMSS") & "_" & Application.CurrentProject.Name
   '
   On Error GoTo Err_Backup
   '
   FileCopy srcepath, destpath
  
   'MsgBox "Database successfully backed up ! ", vbInformation
Bckup_Exit:
   Exit Sub
Err_Backup:
   MsgBox " Backup failed ! -> " & Err.Number & "-" & Err.Description
   Resume Bckup_Exit
End Sub
'------------------------------------------------------------
Public Sub FileCopy(Srce As String, Dest As String)
  Dim fs As Object
 
  Set fs = CreateObject("Scripting.FileSystemObject")
  fs.CopyFile Srce, Dest
  Set fs = Nothing
End Sub

Best,
Jiri
Thanks bro. But a little more guide. how do i create the dialog for this? Thanks
 

Users who are viewing this thread

Top Bottom