Si vous souhaitez compacter/réparer un fichier mdb externe (pas celui dans lequel vous travaillez actuellement):
Application.compactRepair sourecFile, destinationFile
Si vous souhaitez compacter la base de données avec laquelle vous travaillez:
Application.SetOption "Auto compact", True
Dans ce dernier cas, votre application sera compactée lors de la fermeture du fichier.
Mon avis: écrire quelques lignes de code dans un fichier "compresseur" supplémentaire que vous pouvez appeler lorsque vous voulez compresser/réparer un fichier mdb est très utile: dans la plupart des situations, le fichier à compacter ne peut plus être ouvert normalement , vous devez donc appeler la méthode depuis l’extérieur du fichier.
Sinon, l'autocompact doit être défini par défaut sur true dans chaque module principal d'une application Access.
En cas de sinistre, créez un nouveau fichier mdb et importez tous les objets du fichier buggy. Vous trouverez généralement un objet défectueux (formulaire, module, etc.) que vous ne pourrez pas importer.
Essayez d'ajouter ce module, assez simple, il suffit de lancer Access, ouvre la base de données, définit l'option "Compacter à la fermeture" sur "True", puis se ferme.
Syntaxe à compacter automatiquement:
acCompactRepair "C:\Folder\Database.accdb", True
Pour revenir à la valeur par défaut *:
acCompactRepair "C:\Folder\Database.accdb", False
* pas nécessaire, mais si votre base de données dorsale est supérieure à 1 Go, cela peut être assez gênant lorsque vous y allez directement et qu'il faut 2 minutes pour arrêter!
EDIT: ajout de l’option de recurse dans tous les dossiers, je lance cette opération tous les soirs pour garder les bases de données au minimum.
'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
Pour Access 2013, vous pouvez simplement faire
Sendkeys "%fic"
Cela revient à taper ALT, F, I, C sur votre clavier.
C'est probablement une séquence de lettres différente pour différentes versions, mais le symbole "%" signifie "ALT", conservez-le dans le code. vous devrez peut-être simplement changer les lettres, selon les lettres qui apparaissent lorsque vous appuyez sur ALT.
Les lettres qui apparaissent lorsque vous appuyez sur ALT dans Access 2013
Lorsque l'utilisateur quitte la fonction FE, essayez de renommer le MDB principal, de préférence avec la date du jour dans le nom au format aaaa-mm-jj. Assurez-vous de fermer tous les formulaires liés, y compris les formulaires masqués, et les rapports avant de le faire. Si vous recevez un message d'erreur, oups, il est occupé, alors ne vous embêtez pas. S'il réussit, compactez-le à nouveau.
Voir ma Sauvegarde, faites-vous confiance aux utilisateurs ou aux administrateurs système? astuces page pour plus d'informations.
Essaye ça. Cela fonctionne sur la même base de données dans laquelle le code réside. Appelez simplement la fonction CompactDB () illustrée ci-dessous. Assurez-vous qu'après avoir ajouté la fonction, vous cliquez sur le bouton Enregistrer dans la fenêtre de l'éditeur VBA avant la première exécution. Je l'ai seulement testé dans 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
Si vous avez la base de données avec un front-end et un back-end. Vous pouvez utiliser le code suivant sur le formulaire principal de votre formulaire de navigation principale front-end:
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
Oui c'est simple à faire.
Sub CompactRepair()
Dim control As Office.CommandBarControl
Set control = CommandBars.FindControl( Id:=2071 )
control.accDoDefaultAction
End Sub
Fondamentalement, il trouve simplement le menu "Compacter et réparer" et clique dessus, par programmation.
DBEngine.CompactDatabase source, dest
Application.SetOption "Auto compact", False '(mentionné ci-dessus) Utilisez-le avec la légende du bouton: "DB Not Compact on Close".
Écrivez le code pour basculer la légende avec "DB Compact on Close" avec Application.SetOption "Auto compact", True
AutoCompact peut être défini à l’aide du bouton ou par code, par exemple après l’importation de tables temporaires volumineuses.
Le formulaire de démarrage peut avoir un code qui désactive le compactage automatique, de sorte qu'il ne s'exécute pas à chaque fois.
De cette façon, vous n'essayez pas de lutter contre Access.
J'ai fait cela de nombreuses années en 2003, voire 97, beurk!
Si je me souviens bien, vous devez utiliser l’une des sous-commandes ci-dessus associée à une minuterie. Vous ne pouvez pas utiliser la base de données avec des connexions ou des formulaires ouverts.
Vous faites donc quelque chose pour fermer tous les formulaires et lancez la minuterie comme dernière méthode en cours d'exécution. (qui à son tour appellera l'opération compacte une fois que tout sera fermé)
Si vous ne le savez pas, je pourrais creuser dans mes archives et le récupérer.
Si vous ne souhaitez pas utiliser compact à la fermeture (par exemple, parce que la mdb front-end est un programme de robot qui s'exécute continuellement) et que vous ne voulez pas créer une mdb distincte uniquement pour le compactage, envisagez d'utiliser un fichier cmd.
Je laisse mon robot.mdb vérifier sa propre taille:
FileLen(CurrentDb.Name))
Si sa taille dépasse 1 Go, il crée un fichier cmd comme celui-ci ...
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
... lance le fichier cmd ...
Shell ExtractFileDir(CurrentDb.Name) & "comrep.cmd"
... et ferme ...
DoCmd.Quit
Ensuite, le fichier cmd se compresse et redémarre robot.mdb.