MS Access how to compact current database in VBA

Question

Pretty simple question  I know

User · Accepted Answer

If you want to compact repair an external mdb file  not the one you are working in just now    Application compactRepair sourecFile  destinationFile   If you want to compact the database you are working with   Application SetOption  Auto compact   True   In this last case  your app will be compacted when closing the file   My opinion  writting a few lines of code in an extra MDB  compacter  file that you can call when you want to compact repair an mdb file is very usefull  in most situations the file that needs to be compacted cannot be opened normally anymore  so you need to call the method from outside the file   Otherwise  the autocompact shall by default be set to true in each main module of an Access app   In case of a disaster  create a new mdb file and import all objects from the buggy file  You will usually find a faulty object  form  module  etc  that you will not be able to import

User · Answer

If you don t wish to use compact on close  eg  because the front-end mdb is a robot program that runs continually   and you don t want to create a separate mdb just for compacting  consider using a cmd file    I let my robot mdb check its own size   FileLen CurrentDb Name     If its size exceeds 1 GB  it creates a cmd file like this      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    gt     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  amp   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    amp  Folder  amp   robot ldb goto checkldb1      Print  f  Access  amp       amp  Folder  amp   robot mdb  compact       wait until the robot mdb closes  then start it     Print  f    checkldb2      Print  f   if exist    amp  Folder  amp   robot ldb goto checkldb2      Print  f  Access  amp       amp  Folder  amp   robot mdb      Close f       launches the cmd file      Shell ExtractFileDir CurrentDb Name   amp   comrep cmd        and shuts down      DoCmd Quit   Next  the cmd file compacts and restarts robot mdb

User · Answer

When the user exits the FE attempt to rename the backend MDB preferably with todays date in the name in yyyy-mm-dd format   Ensure you close all bound forms  including hidden forms  and reports before doing this    If you get an error message  oops  its busy so don t bother   If it is successful then compact it back    See my Backup  do you trust the users or sysadmins  tips page for more info

User · Answer

DBEngine CompactDatabase source  dest

User · Answer

Try adding this module  pretty simple  just launches Access  opens the database  sets the  Compact on Close  option to  True   then quits   Syntax to auto-compact   acCompactRepair  C  Folder Database accdb   True   To return to default    acCompactRepair  C  Folder Database accdb   False    not necessary  but if your back end database is  1GB this can be rather annoying when you go into it directly and it takes 2 minutes to quit   EDIT  added option to recurse through all folders  I run this nightly to keep databases down to a 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     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  amp  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    gt  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  amp  vFile  amp  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  amp    databases compacted successfully  taking    amp  CInt Timer - t   amp    seconds  and reducing storage overheads by    amp  Int SizeBefore - SizeAfter   amp   MB   amp  vbLf  amp  vbLf  amp   Size Before     amp  Int SizeBefore   amp   MB   amp  vbLf  amp   Size After     amp  Int SizeAfter   amp   MB      If j  gt  0 Then accSweepForDatabases   accSweepForDatabases  amp  vbLf  amp  j  amp    failures    amp  vbLf  amp  vbLf  amp  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  amp  strFileSpec  On Error GoTo 0     Do While strTemp  lt  gt  vbNullString         colFiles Add strFolder  amp  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  lt  gt  vbNullString             If  strTemp  lt  gt       And  strTemp  lt  gt        Then                 If  GetAttr strFolder  amp  strTemp  And vbDirectory   lt  gt  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  amp  vFolderName  strFileSpec  True          Next vFolderName     End If  End Function  Private Function TrailingSlash strFolder As String  As String     If Len strFolder   gt  0 Then         If Right strFolder  1        Then             TrailingSlash   strFolder         Else             TrailingSlash   strFolder  amp              End If     End If End Function

User · Answer

Try this  It works on the same database in which the code resides  Just call the CompactDB   function shown below  Make sure that after you add the function  you click the Save button in the VBA Editor window prior to running for the first time  I only tested it in Access 2010  Ba-da-bing  ba-da-boom   Public Function CompactDB        Dim strWindowTitle As String      On Error GoTo err Handler      strWindowTitle   Application Name  amp    -    amp  Left Application CurrentProject Name  Len Application CurrentProject Name  - 4      strTempDir   Environ  Temp       strScriptPath   strTempDir  amp    compact vbs      strCmd    wscript    amp        amp  strScriptPath  amp            Open strScriptPath For Output As  1     Print  1   Set WshShell   WScript CreateObject   WScript Shell         Print  1   WScript Sleep 1000      Print  1   WshShell AppActivate    amp        amp  strWindowTitle  amp           Print  1   WScript Sleep 500      Print  1   WshShell SendKeys    yc        Close  1      Shell strCmd  vbHide     Exit Function      err Handler      MsgBox  Error    amp  Err Number  amp        amp  Err Description     Close  1  End Function

User · Answer

If you have the database with a front end and a back end  You can use the following code on the main form of your front end main navigation form   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    amp  Format Now   YYYY-MM-DD HHMMSS    amp    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   lt  gt     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   lt  gt     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    amp  vbCrLf  amp  vbCrLf                    amp   Size before     amp  Round s1   1024   1024  2   amp   Mb   amp  vbCrLf                    amp   Size after        amp  Round s2   1024   1024  2   amp   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

User · Answer

Check out this solution VBA Compact Current Database   Basically it says this should work  Public Sub CompactDB        CommandBars  Menu Bar   Controls  Tools   Controls   Database utilities          Controls  Compact and repair database      accDoDefaultAction  End Sub

User · Answer

For Access 2013  you could just do  Sendkeys   fic    This is the same as typing ALT  F  I  C on your keyboard   It s probably a different sequence of letters for different versions  but the     symbol means  ALT   so keep that in the code  you may just need to change the letters  depending on what letters appear when you press ALT  Letters that appear when pressing ALT in Access 2013

User · Answer

Application SetOption  Auto compact   False   mentioned above  Use this with a button caption   DB Not Compact On Close   Write code to toggle the caption with  DB Compact On Close   along with Application SetOption  Auto compact   True  AutoCompact can be set by means of the button or by code  ex  after importing large temp tables   The start up form can have code that turns off Auto Compact  so that it doesn t run every time   This way  you are not trying to fight Access

User · Answer

I did this many years back on 2003 or possibly 97  yikes   If I recall you need to use one of the subcommands above tied to a timer   You cannot operate on the db with any connections or forms open     So you do something about closing all forms  and kick off the timer as the last running method   which will in turn call the compact operation once everything closes   If you haven t figured this out I could dig through my archives and pull it up

User · Answer

There s also Michael Kaplan s SOON   Shut One  Open New   add-in  You d have to chain it  but it s one way to do this   I can t say I ve had much reason to ever want to do this programatically  since I m programming for end users  and they are never using anything but the front end in the Access user interface  and there s no reason to regularly compact a properly-designed front end

User · Answer

Yes it is simple to do   Sub CompactRepair     Dim control As Office CommandBarControl   Set control   CommandBars FindControl  Id  2071     control accDoDefaultAction End Sub   Basically it just finds the  Compact and repair  menuitem and clicks it  programatically

[database] MS Access: how to compact current database in VBA

Examples related to database

Examples related to ms-access