MS Access: cómo compactar la base de datos actual en VBA

Una pregunta bastante simple, lo sé.

Si desea compactar / reparar un archivo mdb externo (no el que está trabajando en este momento):

Application.compactRepair sourecFile, destinationFile 

Si desea compactar la base de datos con la que está trabajando:

 Application.SetOption "Auto compact", True 

En este último caso, su aplicación se compactará al cerrar el archivo.

Mi opinión: escribir algunas líneas de código en un archivo MDB “compacter” adicional al que puede llamar cuando quiere compactar / reparar un archivo mdb es muy útil: en la mayoría de las situaciones, el archivo que necesita compactarse ya no puede abrirse normalmente. , por lo que debe llamar al método desde fuera del archivo.

De lo contrario, el autocompacto se establecerá de manera predeterminada en verdadero en cada módulo principal de una aplicación de Access.

En caso de un desastre, cree un nuevo archivo mdb e importe todos los objetos del archivo con errores. Por lo general, encontrará un objeto defectuoso (formulario, módulo, etc.) que no podrá importar.

Intente agregar este módulo, bastante simple, simplemente abre Access, abre la base de datos, establece la opción “Compactar al cerrar” en “Verdadero”, luego se cierra.

Sintaxis para autocompactar:

 acCompactRepair "C:\Folder\Database.accdb", True 

Para volver al valor predeterminado *:

 acCompactRepair "C:\Folder\Database.accdb", False 

* No es necesario, pero si su base de datos de fondo es> 1GB, esto puede ser bastante molesto cuando se accede directamente y tarda 2 minutos en salir.

EDITAR: opción agregada para recurse a través de todas las carpetas, la ejecuto cada noche para mantener las bases de datos al mínimo.

 '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 ' TJP@tomparish.me.uk ' 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 

Sí, es simple de hacer.

 Sub CompactRepair() Dim control As Office.CommandBarControl Set control = CommandBars.FindControl( Id:=2071 ) control.accDoDefaultAction End Sub 

Básicamente, solo encuentra el elemento de menú “Compactar y reparar” y hace clic en él, programáticamente.

Cuando el usuario sale del bash de FE para cambiar el nombre del MDB del back-end de preferencia con la fecha de hoy en el nombre en el formato aaaa-mm-dd. Asegúrese de cerrar todos los formularios enlazados, incluidos los formularios ocultos, y los informes antes de hacer esto. Si aparece un mensaje de error, ¡ay !, está ocupado, así que no te molestes. Si tiene éxito, cópielo de nuevo.

Mira mi copia de seguridad, ¿confías en los usuarios o administradores del sistema? página de consejos para más información.

Si tiene la base de datos con una interfaz y un servidor. Puede usar el siguiente código en la forma principal de su formulario de navegación principal frontal:

 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 

Prueba esto. Funciona en la misma base de datos en la que reside el código. Simplemente llame a la función CompactDB () que se muestra a continuación. Asegúrese de que después de agregar la función, haga clic en el botón Guardar en la ventana del Editor de VBA antes de ejecutar por primera vez. Solo lo probé en 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 

Para Access 2013, puedes hacer

 Sendkeys "%fic" 

Esto es lo mismo que escribir ALT, F, I, C en su teclado.

Probablemente sea una secuencia de letras diferente para diferentes versiones, pero el símbolo “%” significa “ALT”, así que guárdelo en el código. Puede que necesite cambiar las letras, dependiendo de qué letras aparecen cuando presiona ALT

Letras que aparecen al presionar ALT en Access 2013

Lo hice hace muchos años en 2003 o posiblemente 97, ¡sí!

Si recuerdo, necesitas usar uno de los subcomandos anteriores vinculados a un temporizador. No puede operar en el db con ninguna conexión o formulario abierto.

Por lo tanto, debe hacer algo para cerrar todas las formas y poner en marcha el temporizador como último método de ejecución. (que a su vez llamará a la operación compacta una vez que todo se cierre)

Si no te has dado cuenta de esto, podría buscar en mis archivos y subirlo.

DBEngine.CompactDatabase fuente, dest

Application.SetOption “Auto compact”, False ‘(mencionado anteriormente) Use esto con un título de botón: “DB no compacto al cerrar”

Escriba el código para alternar la leyenda con “DB Compact al cerrar” junto con Application.SetOption “Auto compact”, True

AutoCompact se puede configurar por medio del botón o por código, por ejemplo: después de importar tablas temporales grandes.

El formulario de inicio puede tener un código que apaga Auto Compact, de modo que no se ejecute todas las veces.

De esta manera, no estás tratando de luchar contra Access.

Si no desea utilizar Compact al cerrar (p. Ej., Porque el front-end mdb es un progtwig de robot que se ejecuta continuamente), y no desea crear un mdb separado solo para compactarlo, considere usar un archivo cmd.

Dejo que mi robot.mdb compruebe su propio tamaño:

 FileLen(CurrentDb.Name)) 

Si su tamaño excede 1 GB, crea un archivo cmd como este …

 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 

… lanza el archivo cmd …

 Shell ExtractFileDir(CurrentDb.Name) & "comrep.cmd" 

… y se apaga …

 DoCmd.Quit 

A continuación, el archivo cmd compacta y reinicia robot.mdb.

Consulte esta solución VBA Compact Current Database .

Básicamente dice que esto debería funcionar

 Public Sub CompactDB() CommandBars("Menu Bar").Controls("Tools").Controls ("Database utilities"). _ Controls("Compact and repair database...").accDoDefaultAction End Sub 

También está el complemento SOON de Michael Kaplan (“Cerrar uno, abrir nuevo”) . Tendría que encadenarlo, pero es una forma de hacerlo.

No puedo decir que haya tenido muchas razones para querer hacer esto programáticamente, ya que estoy progtwigndo para usuarios finales, y nunca usan nada más que la interfaz en la interfaz de usuario de Access, y no hay ninguna razón para hacerlo regularmente. compacte un frente diseñado apropiadamente.