Как сделать программно Backup базы Access

Private Sub Command1_Click()
Dim strAppPath As String
Dim idProg As Long
Dim DirectoryFound As String ' для проверки существования папки
 
'сохраним путь базы
strAppPath = Application.CurrentProject.Path & "\"
'На выходе из программы -
'Проверяем наличие файла Нарушения ПДД_data.mdb, если есть, то
'Проверяем наличие файла Нарушения ПДД_data.ldb, если его нет, то
'предлагаем перед выход сделать архивацию, если согласен то, архивация и выход.......
If Dir(strAppPath & "Нарушения_ПДД_data.mdb") <> "" Then
' значит, файл Нарушения_ПДД_data.mdb существует - это сервер!
    If Dir(strAppPath & "Нарушения_ПДД_data.ldb") = "" Then
    ' значит, файл блокировки не существует - никто не занимает файл
        If MsgBox("Не забывайте создавать архивную копию базы данных при завершении работы." & vbCrLf & vbCrLf & _
            "Создать архивную копию базы сейчас ?", vbInformation + vbYesNo, _
            "Архивация данных после завершения работы") = vbYes Then
            'проверить, есть ли файл WinRar.exe в папке \AddOns
            If Dir(strAppPath & "AddOns\WinRAR.exe") = "" Then
                MsgBox "Не найден архиватор WinRar.exe в подпапке \AddOns!", vbCritical,    "Невозможно начать архивацию данных"
                Exit Sub
            End If
            'проверить наличие папки \Archives
            DirectoryFound = Dir(strAppPath & "Arhives", vbDirectory)
            If (Len(DirectoryFound) = 0 Or Err = 76) Then 'errPathNotFound = 76
                MsgBox "Не найдена папка \Arhives для размещения архива", vbCritical, "Не найдена папка для архивов"
                Exit Sub
            End If
            idProg = Shell(strAppPath & "AddOns\WinRAR a -r -m5 -ag_DD-MM-YYYY_HH-MM " & strAppPath & "Arhives\Нарушения_ПДД_data " & strAppPath & "Нарушения_ПДД_data.mdb", vbNormalFocus)
        End If
    End If
End If
End Sub

strAppPath = App.Path & "\"

strAppPath = CurDir & "\"

Private Sub Command1_Click()
    WinRarApp$ = "C:\Program Files\WinRAR\WinRAR.exe e -p311 -o+"
    ' e  - разархивировать
    ' -o+  - перезаписывать существующие файлы
    iPath = "H:\fortest\oldFolder\"
    iArhivName$ = "db2.rar"
    adr$ = WinRarApp$ & " """ & iPath & iArhivName$ & """ """ & iPath & """ "
    RetVal = Shell(adr$, vbHide)
    FileCopy iPath & "db2.mdb", "H:\fortest\newFolder\" & "db2.mdb"
End Sub

Const pFile As String = "H:\fortest\oldFolder\", pArchive As String = "H:\fortest\newFolder\"
Const nFile As String = "db2.mdb", nArchive As String = "db2.rar"
 
Private Sub Command1_Click() ' создаём архив
    Dim WinRarApp As String, adr As String
    WinRarApp = "C:\Program Files\WinRAR\WinRAR.exe a -ep "
    ' a   - заархивировать
    ' -ep   - исключить пути из имён
    adr = WinRarApp & " """ & pArchive & nArchive & """ """ & pFile & nFile & """ "
    Shell adr, vbHide
    Text1.Text = pArchive & nArchive
End Sub
 
Private Sub Command2_Click() ' разархивируем
    Dim WinRarApp As String, adr As String
    WinRarApp = "C:\Program Files\WinRAR\WinRAR.exe e -o+"
    ' e  - разархивировать
    ' -o+  - перезаписывать существующие файлы
    adr = WinRarApp & " """ & pArchive & nArchive & """ """ & pFile & """ "
    Shell adr, vbHide
End Sub
 
Private Sub Command3_Click() ' Проверка наличия архива
If Dir(Text1.Text) <> "" Then
    MsgBox "Архив есть!"
Else
    MsgBox "Архива нету!"
End If
End Sub

Const pFile As String = "H:\fortest\oldFolder\", pArchive As String = "H:\fortest\newFolder\"
Const nFile As String = "db2.mdb", nArchive As String = "db2.rar"