Dear All,
I have the following code that backup a dynamic BE. It works when the BE is on the same project path as the FE. When the BE is on a server, it reports error of Path Not Found.
Please can anyone help me locate the error in my Code?
Thanks in advance I am grateful for you taking the time to even read my post.
Regards,
SS.
I have the following code that backup a dynamic BE. It works when the BE is on the same project path as the FE. When the BE is on a server, it reports error of Path Not Found.
Please can anyone help me locate the error in my Code?
Thanks in advance I am grateful for you taking the time to even read my post.
Regards,
SS.
Code:
Private Sub cmdBackUp_Click()
'******************************
Dim str As String
Dim buf As String
Dim MD_Date As Variant
Dim fs As Object
Dim source As String
Const conPATH_FILE_ACCESS_ERROR = 75
On Error GoTo Backup_Button_Backup
'buf = Back Up Folder
'buf is created if it does not exist
'CurrentProject.Path = the path that the FE is located
'-------------------
Dim strBackEndPath As String
Dim lenPath As Integer
Dim i As Integer
Dim j As Integer
strBackEndPath = CurrentDb.TableDefs("tblProtocols").Connect 'tblProtocols is one of the tables in the database.
' To remove the database & password prefix
j = InStrRev(strBackEndPath, "=") + 1
strBackEndPath = Mid(strBackEndPath, j)
'-----------------
buf = strBackEndPath & "\Backups\"
MkDir buf
'-----------------
Resume Backup_Button_Backup
Backup_Button_Backup:
'-----------------
On Error GoTo Err_Button_Backup
'-----------
MD_Date = Format(Date, "dd-mm-yyyy ") & Format(Time, "hh-mm-ss")
'str = CurrentProject.path & "\Backups\" & MD_Date
str = strBackEndPath & "\Backups\" & MD_Date
MkDir str
'--------------------------
'Source = where the data is stored
source = strBackEndPath
'---------------------
MsgBox "The path is " & source, vbOKOnly 'Just to preview the path.
Set fs = CreateObject("Scripting.FileSystemObject")
'Change the file extension as needed
fs.CopyFile source & "\*.accdb", str
Set fs = Nothing
MsgBox "Data backup at " & vbCrLf & MD_Date & vbCrLf & "successfully!", _
vbInformation, "DATATWINE: Backup Successful"
'--------------------------
'Create a Log of the backup made
DoCmd.SetWarnings False
On Error Resume Next
Me.txtValueMonth.Value = Format$(Me.txtValueDate.Value, "mmmm")
DoCmd.RunSQL "INSERT INTO tblBackups (ValueDate, ValueMonth, BackupBy, FinancialYear, CurrentUser, BackupFilePath) " _
& " SELECT Forms!frmMaintenance_Main!txtValueDate, Forms!frmMaintenance_Main!txtValueMonth, Forms!frmMaintenance_Main!txtUserName, Forms![frmMaintenance_Main]![frmProtocols_sbf]!txtCurrentYear , Forms!frmMaintenance_Main!txtUserName, CurrentProject.path & '\Backups\'" _
& ""
DoCmd.SetWarnings True
''---------------------------
''This line compact's the database
'I need a code HERE to pack the new backup file.
''---------------------------
Exit_Button_Backup:
Exit Sub
Err_Button_Backup:
If Err.Number = conPATH_FILE_ACCESS_ERROR Then
MsgBox "The following Path, " & str & ", already exists or there was an Error " & _
"accessing it!", vbExclamation, "Path/File Access Error"
Else
MsgBox Err.Description, vbExclamation, "Error Creating " & str
End If
Resume Exit_Button_Backup
End Sub