How to compact the current MS Access database from VBA function
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 &amp; "_1"
Kill fileLocation
Name fileLocation &amp; "_1" As fileLocation


You might also notice the Access compact and repair button doing something similar. If you run compact &amp; 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:


Programmatically create a VBScript file
Add code to that file so we can compact &amp; repair our database without having it open
Open and run that file asynchronously
Close our database before the compact &amp; repair happens
Compact and repair the database (creating a copy), deleting the old one, renaming the copy
Reopen our database, continue the batch
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 &amp; "\CRHelper.vbs"
    If Dir(CurrentProject.Path &amp; "\CRHelper.vbs") &lt;&gt; "" Then
        Kill CurrentProject.Path &amp; "\CRHelper.vbs"
    End If
    Dim vbStr As String
    vbStr = "dbName = """ &amp; CurrentProject.FullName &amp; """" &amp; vbCrLf &amp; _
    "resumeFunction = ""ResumeBatch""" &amp; vbCrLf &amp; _
    "Set app = CreateObject(""Access.Application"")" &amp; vbCrLf &amp; _
    "Set dbe = app.DBEngine" &amp; vbCrLf &amp; _
    "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" &amp; vbCrLf &amp; _
    "On Error Resume Next" &amp; vbCrLf &amp; _
    "Do" &amp; vbCrLf &amp; _
    "If Err.Number &lt;&gt; 0 Then Err.Clear" &amp; vbCrLf &amp; _
    "WScript.Sleep 500" &amp; vbCrLf &amp; _
    "dbe.CompactDatabase dbName, dbName &amp; ""_1""" &amp; vbCrLf &amp; _
    "errCount = errCount + 1" &amp; vbCrLf &amp; _
    "Loop While err.Number &lt;&gt; 0 And errCount &lt; 100" &amp; vbCrLf &amp; _
    "If errCount &lt; 100 Then" &amp; vbCrLf &amp; _
    "objFSO.DeleteFile dbName" &amp; vbCrLf &amp; _
    "objFSO.MoveFile dbName &amp; ""_1"", dbName" &amp; vbCrLf &amp; _
    "app.OpenCurrentDatabase dbName" &amp; vbCrLf &amp; _
    "app.UserControl = True" &amp; vbCrLf &amp; _
    "app.Run resumeFunction" &amp; vbCrLf &amp; _
    "End If" &amp; vbCrLf &amp; _
    "objFSO.DeleteFile Wscript.ScriptFullName" &amp; 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 """" &amp; vbscrPath &amp; """"
    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.