3

I want to be able to run the 'compact and repair' process from within a VBA module in the database.

I have a batch process that I run occasionally, it drops a few old tables, re-imports them from other databases, renames a couple of fields, does a few updates and makes a few other minor changes. The process isn't rocket science, but there are several steps so it really does needs to be automated.

The problem is that a couple of the steps (the UPDATEs) temporarily increase the size of the database which can cause problems with subsequent imports.

If I do the process manually (including compacting) then everything works fine and I end up with a 800MByte database. If I use my automated VBA script (without compacting) then it crashes halfway through when the database busts the 2Gbyte limit.

I've found several threads on this subject, but they're all three of four years old (or more) and the methods they describe don't seem to work anymore.

Are they're any solutions that work with Office 365 (version 1720)?

The 'auto compact' causes the database to compact on closing, it does NOT allow the compaction of the database to be added between steps.

I've tried this:

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

And this:

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

And this....

Public Sub CompactDb3()
    Application.SetOption "Auto compact", True
End Sub

Amongst other

  • This same question has been answered on Stack Overflow. See stackoverflow.com/questions/2831749/… – C Perkins Dec 16 '17 at 3:29
  • @CPerkins Yes, but with a lot of wrong/conflicting information, and links to offsite resources. If I have the time, I might post an adjusted version of my answer there to explain why the most upvoted answer is just plain wrong (it compacts a backend, which is not the current database). – Erik A Dec 16 '17 at 9:40
  • @ErikvonAsmuth I agree that your new answer is better and that the old question had a mixed bag of answers. I pointed it out to emphasize that it had been asked already and could possibly be a useful reference. Sufficient research might have avoided this duplicate question. There are many disagreements in meta forums, but the overall consensus (that I understand) is to improve answers of existing questions and then mark duplicate questions accordingly. I personally don't have enough reputation to merge/migrate/update either question. – C Perkins Dec 16 '17 at 20:34
  • Yes, it's indeed dupe-y if not a clean dupe. You could try mod-flagging it for the merge (don't know if you should flag on SO or on DBA, it seems on-topic on both so migrating is a bit artificial). Since the answers there were very unsatisfactory, I've posted mine there too. But that indeed duplicates content – Erik A Dec 16 '17 at 20:46
4

This is simply not possible. Compacting and repairing a database requires the database to be closed. As such, you can't compact and repair a database between steps in a sub or procedure, since the database is open when running the procedure.

You might notice the Compact and repair button on the ribbon requires an exclusive lock, closes the database, then compacts and repairs, and then reopens it.

My advice: either run the process from an external database, a VBScript file or PowerShell. Run the first part of your batch, close the file, compact and repair, reopen, run second part

Sample code

Dim fileLocation As String
DBEngine.CompactDatabase fileLocation, fileLocation & "_1"
Kill fileLocation
Name fileLocation & "_1" As fileLocation

You might also notice the Access compact and repair button doing something similar. If you run compact & repair, it moves the data to a database called Database.accdb in your current folder (name might vary based on existing names/database type), then deletes your current database, and then renames the new one.


Well, but nothing is impossible, right?

Well, some things are, but this isn't one of them, if you're willing to do some weird trickery. As I just said, the main problem is that the current database has to be closed. So, the workaround does the following:

  1. Programmatically create a VBScript file
  2. Add code to that file so we can compact & repair our database without having it open
  3. Open and run that file asynchronously
  4. Close our database before the compact & repair happens
  5. Compact and repair the database (creating a copy), deleting the old one, renaming the copy
  6. Reopen our database, continue the batch
  7. Delete the newly created file

Luckily, I had some time to spare, so I came up with the following solution:

Public Sub CompactRepairViaExternalScript()
    Dim vbscrPath As String
    vbscrPath = CurrentProject.Path & "\CRHelper.vbs"
    If Dir(CurrentProject.Path & "\CRHelper.vbs") <> "" Then
        Kill CurrentProject.Path & "\CRHelper.vbs"
    End If
    Dim vbStr As String
    vbStr = "dbName = """ & CurrentProject.FullName & """" & vbCrLf & _
    "resumeFunction = ""ResumeBatch""" & vbCrLf & _
    "Set app = CreateObject(""Access.Application"")" & vbCrLf & _
    "Set dbe = app.DBEngine" & vbCrLf & _
    "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf & _
    "On Error Resume Next" & vbCrLf & _
    "Do" & vbCrLf & _
    "If Err.Number <> 0 Then Err.Clear" & vbCrLf & _
    "WScript.Sleep 500" & vbCrLf & _
    "dbe.CompactDatabase dbName, dbName & ""_1""" & vbCrLf & _
    "errCount = errCount + 1" & vbCrLf & _
    "Loop While err.Number <> 0 And errCount < 100" & vbCrLf & _
    "If errCount < 100 Then" & vbCrLf & _
    "objFSO.DeleteFile dbName" & vbCrLf & _
    "objFSO.MoveFile dbName & ""_1"", dbName" & vbCrLf & _
    "app.OpenCurrentDatabase dbName" & vbCrLf & _
    "app.UserControl = True" & vbCrLf & _
    "app.Run resumeFunction" & vbCrLf & _
    "End If" & vbCrLf & _
    "objFSO.DeleteFile Wscript.ScriptFullName" & vbCrLf
    Dim fileHandle As Long
    fileHandle = FreeFile
    Open vbscrPath For Output As #fileHandle
    Print #fileHandle, vbStr
    Close #fileHandle
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    wsh.Run """" & vbscrPath & """"
    Set wsh = Nothing
    Application.Quit
End Sub

This does all the steps outlined above, and resumes the batch by calling the ResumeBatch function on the database that called this function (without any parameters). Note that things like click-to-run protection and antivirus/policy not liking vbscript files can ruin this approach.

  • I get error on Line 3 of the vbScript: "Could not locate automation class named 'DAO.DBEngine.120'." – Luca Guarro Sep 6 '18 at 1:42
  • 1
    @LucaGuarro Sounds like this problem. I've implemented a workaround that uses the default database engine of the Access Application object instead of a separate DBEngine object. The previous edit should work fine under anything except Access 2016 CTR – Erik A Sep 6 '18 at 10:15
0

Here is the VBA code, I have tried and worked, run from Excel ;

Sub CompactAndRepairAccessDB()

    Dim Acc As Object
    Set Acc = CreateObject("access.application")

    Dim dbPath As String, dbPathX As String
    dbPath = Application.ThisWorkbook.Path & "\" & "YourDatabaseNameHere.accdb"
    dbPathX = Application.ThisWorkbook.Path & "\" & "tmp.accdb"

    Acc.DBEngine.CompactDatabase dbPath, dbPathX
    Acc.Quit
    Set Acc = Nothing
    Kill dbPath
    Name dbPathX As dbPath

End Sub

Found the solution in this link and modified a little bit.

http://www.vbaexpress.com/forum/showthread.php?9262-Solved-VBA-Compact-and-Repair

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.