Public Sub CreateBackUp() Dim strDBPath As String Dim fso As Object If MsgBox("Создать резервную копию БД ?", _             vbYesNo Or vbQuestion Or vbDefaultButton1, _             "Создание резервной копии") = vbYes Then     strDBPath = CurrentDb.Name     Set fso = CreateObject("Scripting.FileSystemObject")     fso.CopyFile strDBPath, Left(strDBPath, Len(strDBPath) - 3) & "bak" End If Application.Quit acQuitSaveAll End Sub

только для варианта когда таблицы и код в одной базе

А код кнопки востановления с резервной копии?

Программное сжатие mdb файла

Описание: Принцип работы кода:
- Запускается функция GetCompactReclaimedSpaceAmount с указанием в параметре имени и пути сжимаемого файла.
1. Проверяем существование файла и формируем имя для временного файла (используем Microsoft Windows Script Host (WSH))
2. Оценим размер высвобождаемого пространства (используем библиотеку ADO (Microsoft ActiveX Data Object))
3. Проверим, все ли отключились от базы (опять ADO)
4. Проведем сжатие базы в новый файл (Microsoft Jet OLE DB Provider и Replication Objects (JRO))
5. Производим замену старого файла на новый.

Использовал позднее связывание, так что должен работать без установленных ссылок на соответствующие библиотеки.

Public Function GetCompactReclaimedSpaceAmount(strFileName As String) Const cstrConnectionString  As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" Dim strNameFileNew          As String Dim lngValue                As Long Dim strMsg                  As String Dim JRO                     As Object Dim File                    As Object Dim cnn                     As Object On Error Resume Next     'Проверям наличие файла для сжатия     Set File = CreateObject("Scripting.FileSystemObject").GetFile(strFileName)     If Err.Number <> 0 Then MsgBox "Файл не существует":    Exit Function          'Формируем имя для временного файла     strNameFileNew = File.ParentFolder.Path & "\~" & File.Name     Set File = Nothing     '======= Оценим размер высвобождаемого пространства          Set cnn = CreateObject("ADODB.Connection")     cnn.Open cstrConnectionString & strFileName     lngValue = cnn.Properties("Jet OLEDB:Compact Reclaimed Space Amount").Value     cnn.Close:      Set cnn = Nothing          If lngValue = 0 Then MsgBox ("Сжатие не требуется."):   Exit Function              Select Case True     Case lngValue < 1024         strMsg = Format$(lngValue, "# ##0.00") & " байт"     Case lngValue < 1048576         strMsg = Format$(lngValue / 1024, "# ##0.00") & " кб."     Case Else         strMsg = Format$(lngValue / 1048576, "# ##0.00") & " мб."     End Select          strMsg = "При сжатии будет высвобождено " & strMsg & Chr(13) & Chr(10) & "Будем сжимать?"          If (MsgBox(strMsg, vbYesNo) <> vbYes) Then Exit Function          '======= Проверим, все ли отключились от базы          If ExistsConnectedUser(strFileName) Then          MsgBox "Не все пользователи отключились от базы."         Exit Function     End If     '====== Проведем сжатие базы в новый файл     'Удалим файл с именем временного файла     Set File = CreateObject("Scripting.FileSystemObject").GetFile(strNameFileNew)     If Err.Number = 0 Then         File.Delete         Set File = Nothing     Else         Err.Clear     End If          'Проведем сжатие     Set JRO = CreateObject("JRO.JetEngine")     JRO.CompactDatabase cstrConnectionString & strFileName, cstrConnectionString & strNameFileNew        '====== Заменим файлов.         If Not (ExistsConnectedUser(strFileName)) Then         Set File = CreateObject("Scripting.FileSystemObject").GetFile(strNameFileNew)         File.Copy strFileName, True         File.Delete     End If End Function 'Функция проверяет имеются ли пользователи подключенные к базе Public Function ExistsConnectedUser(strFileName As String) As Boolean Dim cnn As Object     'As New ADODB.Connection Dim rst As Object     'As ADODB.Recordset     Set cnn = CreateObject("ADODB.Connection")     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFileName     Set rst = cnn.OpenSchema(-1, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")          rst.MoveNext     ExistsConnectedUser = Not rst.EOF          rst.Close:      Set rst = Nothing     cnn.Close:      Set cnn = Nothing End Function

Дополню немножко
Замечание - данный код тестировался и работает на Access 2003. На 2002 и 2000 не тестировался, но должен работать.
Для Access 2007 необходимо внести некоторые изменения.

1.

Const cstrConnectionString  As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="

заменить на

Const cstrConnectionString  As String = " Provider=Microsoft.ACE.OLEDB.12.0;Data Source="

2.

JRO.CompactDatabase cstrConnectionString & strFileName, cstrConnectionString & strNameFileNew

заменить на

JRO.CompactDatabase _ cstrConnectionString & strFileName & ";Jet OLEDB:Engine Type=5", _ cstrConnectionString & strNameFileNew & ";Jet OLEDB:Engine Type=5"

(в принципе, Engine Type по умолчанию равем 5, и почему это не работае в 2007?... Не понятно.)

3.

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFileName

заменить на

cnn.Open "Provider= Microsoft.ACE.OLEDB.12.0;Data Source=" & strFileName

офигеть....

в хорошем смысле ?
вроде как вопрос был про создание резервного архива, а не программное сжатие БД ?

Однозначно в хорошем

Эх, вот если бы еще одной строчкой "отогнать" всех пользователей от файла данных...
PS. Вчера с утра приехал за новой порцией "хочушек", так у половины пользователей на длинные выходные оставлены включенными ПК с открытыми интерфейсами к файлу БД. При условии, что свет у них моргает аккурат 3-4 раза на дню. Б... (далее непереводимый итальянский фольклор с использованием местных идиоматических выражений).

Тут