Довольно простой вопрос, я знаю.
MS Access: как скомпилировать текущую базу данных в VBA
Ответ 1
Если вы хотите сжать/восстановить внешний файл mdb (а не тот, с которым вы сейчас работаете):
Application.compactRepair sourecFile, destinationFile
Если вы хотите сжать базу данных, с которой работаете:
Application.SetOption "Auto compact", True
В этом последнем случае ваше приложение будет сжато при закрытии файла.
Мое мнение: написание нескольких строк кода в дополнительном файле "compacter" MDB, который вы можете вызывать, когда вы хотите компактно/восстановить файл mdb, очень полезно: в большинстве случаев файл, который необходимо сжать, не может быть обычно открываются нормально, поэтому вам нужно вызвать метод извне файла.
В противном случае автокомпакт по умолчанию должен быть равен true в каждом основном модуле приложения Access.
В случае сбоя создайте новый файл mdb и импортируйте все объекты из багги файла. Обычно вы обнаружите неисправный объект (форму, модуль и т.д.), Которые вы не сможете импортировать.
Ответ 2
Попробуйте добавить этот модуль, довольно просто, просто запускает Access, открывает базу данных, устанавливает для параметра "Compact on Close" значение "True", а затем завершает работу.
Синтаксис для автоматического сжатия:
acCompactRepair "C:\Folder\Database.accdb", True
Чтобы вернуться к умолчанию *:
acCompactRepair "C:\Folder\Database.accdb", False
* не обязательно, но если ваша база данных задней базы > 1 ГБ, это может быть довольно неприятно, когда вы входите в нее напрямую, и требуется 2 минуты, чтобы выйти!
EDIT: добавлена возможность рекурсии через все папки, я запускаю эту ночь, чтобы базы данных сведены к минимуму.
'accCompactRepair
'v2.02 2013-11-28 17:25
'===========================================================================
' HELP CONTACT
'===========================================================================
' Code is provided without warranty and can be stolen and amended as required.
' Tom Parish
' [email protected]
' http://baldywrittencod.blogspot.com/2013/10/vba-modules-access-compact-repair.html
' DGF Help Contact: see BPMHelpContact module
'=========================================================================
'includes code from
'http://www.ammara.com/access_image_faq/recursive_folder_search.html
'tweaked slightly for improved error handling
' v2.02 bugfix preventing Compact when bAutoCompact set to False
' bugfix with "OLE waiting for another application" msgbox
' added "MB" to start & end sizes of message box at end
' v2.01 added size reduction to message box
' v2.00 added recurse
' v1.00 original version
Option Explicit
Function accSweepForDatabases(ByVal strFolder As String, Optional ByVal bIncludeSubfolders As Boolean = True _
, Optional bAutoCompact As Boolean = False) As String
'v2.02 2013-11-28 17:25
'sweeps path for .accdb and .mdb files, compacts and repairs all that it finds
'NB: leaves AutoCompact on Close as False unless specified, then leaves as True
'syntax:
' accSweepForDatabases "path", [False], [True]
'code for ActiveX CommandButton on sheet module named "admin" with two named ranges "vPath" and "vRecurse":
' accSweepForDatabases admin.Range("vPath"), admin.Range("vRecurse") [, admin.Range("vLeaveAutoCompact")]
Application.DisplayAlerts = False
Dim colFiles As New Collection, vFile As Variant, i As Integer, j As Integer, sFails As String, t As Single
Dim SizeBefore As Long, SizeAfter As Long
t = Timer
RecursiveDir colFiles, strFolder, "*.accdb", True 'comment this out if you only have Access 2003 installed
RecursiveDir colFiles, strFolder, "*.mdb", True
For Each vFile In colFiles
'Debug.Print vFile
SizeBefore = SizeBefore + (FileLen(vFile) / 1048576)
On Error GoTo CompactFailed
If InStr(vFile, "Geographical Configuration.accdb") > 0 Then MsgBox "yes"
acCompactRepair vFile, bAutoCompact
i = i + 1 'counts successes
GoTo NextCompact
CompactFailed:
On Error GoTo 0
j = j + 1 'counts failures
sFails = sFails & vFile & vbLf 'records failure
NextCompact:
On Error GoTo 0
SizeAfter = SizeAfter + (FileLen(vFile) / 1048576)
Next vFile
Application.DisplayAlerts = True
'display message box, mark end of process
accSweepForDatabases = i & " databases compacted successfully, taking " & CInt(Timer - t) & " seconds, and reducing storage overheads by " & Int(SizeBefore - SizeAfter) & "MB" & vbLf & vbLf & "Size Before: " & Int(SizeBefore) & "MB" & vbLf & "Size After: " & Int(SizeAfter) & "MB"
If j > 0 Then accSweepForDatabases = accSweepForDatabases & vbLf & j & " failures:" & vbLf & vbLf & sFails
MsgBox accSweepForDatabases, vbInformation, "accSweepForDatabases"
End Function
Function acCompactRepair(ByVal pthfn As String, Optional doEnable As Boolean = True) As Boolean
'v2.02 2013-11-28 16:22
'if doEnable = True will compact and repair pthfn
'if doEnable = False will then disable auto compact on pthfn
On Error GoTo CompactFailed
Dim A As Object
Set A = CreateObject("Access.Application")
With A
.OpenCurrentDatabase pthfn
.SetOption "Auto compact", True
.CloseCurrentDatabase
If doEnable = False Then
.OpenCurrentDatabase pthfn
.SetOption "Auto compact", doEnable
End If
.Quit
End With
Set A = Nothing
acCompactRepair = True
Exit Function
CompactFailed:
End Function
'source: http://www.ammara.com/access_image_faq/recursive_folder_search.html
'tweaked slightly for error handling
Private Function RecursiveDir(colFiles As Collection, _
strFolder As String, _
strFileSpec As String, _
bIncludeSubfolders As Boolean)
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
'Add files in strFolder matching strFileSpec to colFiles
strFolder = TrailingSlash(strFolder)
On Error Resume Next
strTemp = ""
strTemp = Dir(strFolder & strFileSpec)
On Error GoTo 0
Do While strTemp <> vbNullString
colFiles.Add strFolder & strTemp
strTemp = Dir
Loop
If bIncludeSubfolders Then
'Fill colFolders with list of subdirectories of strFolder
On Error Resume Next
strTemp = ""
strTemp = Dir(strFolder, vbDirectory)
On Error GoTo 0
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop
'Call RecursiveDir for each subfolder in colFolders
For Each vFolderName In colFolders
Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
Next vFolderName
End If
End Function
Private Function TrailingSlash(strFolder As String) As String
If Len(strFolder) > 0 Then
If Right(strFolder, 1) = "\" Then
TrailingSlash = strFolder
Else
TrailingSlash = strFolder & "\"
End If
End If
End Function
Ответ 3
Да, это просто сделать.
Sub CompactRepair()
Dim control As Office.CommandBarControl
Set control = CommandBars.FindControl( Id:=2071 )
control.accDoDefaultAction
End Sub
В принципе, он просто находит "Compact and repair" menuitem и щелкает его программно.
Ответ 4
Когда пользователь завершает попытку FE переименовать бэкэнда MDB, желательно с текущей датой в имени в формате yyyy-mm-dd. Перед тем, как сделать это, закройте все связанные формы, включая скрытые формы и отчеты. Если вы получите сообщение об ошибке, oops, его занятость, так что не беспокойтесь. Если это удастся, тогда скомбинируйте его.
Посмотрите мой Резервное копирование, доверяете ли вы советам пользователей или sysadmins?, чтобы узнать больше.
Ответ 5
Если у вас есть база данных с передним и задним концами. Вы можете использовать следующий код в основной форме основной формы навигации переднего плана:
Dim sDataFile As String, sDataFileTemp As String, sDataFileBackup As String
Dim s1 As Long, s2 As Long
sDataFile = "C:\MyDataFile.mdb"
sDataFileTemp = "C:\MyDataFileTemp.mdb"
sDataFileBackup = "C:\MyDataFile Backup " & Format(Now, "YYYY-MM-DD HHMMSS") & ".mdb"
DoCmd.Hourglass True
'get file size before compact
Open sDataFile For Binary As #1
s1 = LOF(1)
Close #1
'backup data file
FileCopy sDataFile, sDataFileBackup
'only proceed if data file exists
If Dir(sDataFileBackup vbNormal) <> "" Then
'compact data file to temp file
On Error Resume Next
Kill sDataFileTemp
On Error GoTo 0
DBEngine.CompactDatabase sDataFile, sDataFileTemp
If Dir(sDataFileTemp, vbNormal) <> "" Then
'delete old data file data file
Kill sDataFile
'copy temp file to data file
FileCopy sDataFileTemp, sDataFile
'get file size after compact
Open sDataFile For Binary As #1
s2 = LOF(1)
Close #1
DoCmd.Hourglass False
MsgBox "Compact complete " & vbCrLf & vbCrLf _
& "Size before: " & Round(s1 / 1024 / 1024, 2) & "Mb" & vbCrLf _
& "Size after: " & Round(s2 / 1024 / 1024, 2) & "Mb", vbInformation
Else
DoCmd.Hourglass False
MsgBox "ERROR: Unable to compact data file"
End If
Else
DoCmd.Hourglass False
MsgBox "ERROR: Unable to backup data file"
End If
DoCmd.Hourglass False
Ответ 6
Попробуйте это. Он работает в той же базе данных, в которой находится код. Просто вызовите функцию CompactDB(), показанную ниже. Убедитесь, что после добавления функции вы нажимаете кнопку "Сохранить" в окне редактора VBA перед запуском в первый раз. Я тестировал его только в Access 2010. Ba-da-bing, ba-da-boom.
Public Function CompactDB()
Dim strWindowTitle As String
On Error GoTo err_Handler
strWindowTitle = Application.Name & " - " & Left(Application.CurrentProject.Name, Len(Application.CurrentProject.Name) - 4)
strTempDir = Environ("Temp")
strScriptPath = strTempDir & "\compact.vbs"
strCmd = "wscript " & """" & strScriptPath & """"
Open strScriptPath For Output As #1
Print #1, "Set WshShell = WScript.CreateObject(""WScript.Shell"")"
Print #1, "WScript.Sleep 1000"
Print #1, "WshShell.AppActivate " & """" & strWindowTitle & """"
Print #1, "WScript.Sleep 500"
Print #1, "WshShell.SendKeys ""%yc"""
Close #1
Shell strCmd, vbHide
Exit Function
err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Close #1
End Function
Ответ 7
Я сделал это много лет назад в 2003 году или, возможно, 97, yikes!
Если я помню, вам нужно использовать одну из подкоманд выше, привязанную к таймеру. Вы не можете работать с db при открытии любых подключений или форм.
Итак, вы делаете что-то о закрытии всех форм и запускаете таймер как последний запущенный метод. (который, в свою очередь, вызовет компактную операцию, когда все будет закрыто)
Если вы этого не поняли, я мог бы прорыть мои архивы и подтянуть их.
Ответ 8
DBEngine.CompactDatabase source, dest
Ответ 9
Application.SetOption "Автокомпакт", False (упомянутое выше) Используйте это с надписью на кнопке: "DB Not Compact On Close"
Введите код, чтобы переключить заголовок с помощью "DB Compact On Close" наряду с Application.SetOption "Автокомпакт", True
AutoCompact может быть установлен с помощью кнопки или кода, например: после импорта больших временных таблиц.
У пусковой формы может быть код, который отключает Auto Compact, так что он не запускается каждый раз.
Таким образом, вы не пытаетесь бороться с Access.
Ответ 10
Если вы не хотите использовать compact on close (например, потому что front-end mdb - это программа роботов, которая работает постоянно), и вы не хотите создавать отдельный mdb только для уплотнения, рассмотрите возможность использования cmd файл.
Я разрешил свой robot.mdb проверить свой собственный размер:
FileLen(CurrentDb.Name))
Если его размер превышает 1 ГБ, он создает cmd файл, подобный этому...
Dim f As Integer
Dim Folder As String
Dim Access As String
'select Access in the correct PF directory (my robot.mdb runs in 32-bit MSAccess, on 32-bit and 64-bit machines)
If Dir("C:\Program Files (x86)\Microsoft Office\Office\MSACCESS.EXE") > "" Then
Access = """C:\Program Files (x86)\Microsoft Office\Office\MSACCESS.EXE"""
Else
Access = """C:\Program Files\Microsoft Office\Office\MSACCESS.EXE"""
End If
Folder = ExtractFileDir(CurrentDb.Name)
f = FreeFile
Open Folder & "comrep.cmd" For Output As f
'wait until robot.mdb closes (ldb file is gone), then compact robot.mdb
Print #f, ":checkldb1"
Print #f, "if exist " & Folder & "robot.ldb goto checkldb1"
Print #f, Access & " " & Folder & "robot.mdb /compact"
'wait until the robot mdb closes, then start it
Print #f, ":checkldb2"
Print #f, "if exist " & Folder & "robot.ldb goto checkldb2"
Print #f, Access & " " & Folder & "robot.mdb"
Close f
... запускает cmd файл...
Shell ExtractFileDir(CurrentDb.Name) & "comrep.cmd"
... и выключается...
DoCmd.Quit
Затем файл cmd сжимает и перезапускает robot.mdb.
Ответ 11
Проверьте это решение VBA Compact Current Database.
В основном это говорит, что это должно работать
Public Sub CompactDB()
CommandBars("Menu Bar").Controls("Tools").Controls ("Database utilities"). _
Controls("Compact and repair database...").accDoDefaultAction
End Sub
Ответ 12
Там также Майкл Каплан SOON (надстройка "Завершить один, открыть новый" ). Вы должны были бы связать это, но это один из способов сделать это.
Я не могу сказать, что у меня было много причин когда-либо хотеть делать это программно, так как я программирую для конечных пользователей, и они никогда не используют ничего, кроме front-end в пользовательском интерфейсе Access, и там нет причина регулярного уплотнения правильно спроектированного переднего конца.