Compact Database via VBA

This is the current code that I am trying to run and I am unable to because I already have that file open. Does anyone have any insight or suggestions?

Thank you ahead of time for your help!

Public Sub Compact_MDB()
Dim dbPath As String, OldDbName As String, NewDbName As String
Dim Response As Integer
dbPath = Application.CurrentProject.Path

OldDbName = "ReorderMonitoring" & ".mdb"
NewDbName = "ReorderMonitoringNew" & ".mdb"
DBEngine.CompactDatabase dbPath & "\" & OldDbName, dbPath & "\" & NewDbName

Response = MsgBox("Do you want to delete previous mdb version?", vbYesNo, "Continue")
If Response = vbYes Then
Kill dbPath & "\" & OldDbName
Name dbPath & "\" & NewDbName As dbPath & "\" & OldDbName
Else
Dim OldDbBackup As String
OldDbBackup = Mid(OldDbName, 1, Len(OldDbName) - 4) & "_" & Format(Date, "mmddyy") & ".mdb"
Name dbPath & "\" & OldDbName As dbPath & "\" & OldDbBackup
Name dbPath & "\" & NewDbName As dbPath & "\" & OldDbName
End If
End Sub

You can't delete or rename a database while it is open. However you can modify your code as shown below to give you three different choices

1) Make a backup copy
2) Make a new compacted copy of the database
3) Compact the current database

Public Sub Compact_MDB()
Dim dbPath As String, OldDbName As String, NewDbName As String, DbBackup As String
Dim Response As Integer, fs As Object
dbPath = Application.CurrentProject.Path
OldDbName = "ReorderMonitoring" & ".mdb"
NewDbName = "ReorderMonitoringNew" & ".mdb"
DbBackup = Mid(OldDbName, 1, Len(OldDbName) - 4) & "_" & Format(Date, "mmddyy") & ".mdb"
Response = MsgBox("Do you want to make a Back-Up copy of this Database Named " & vbCrLf & "'" & DbBackup & "'", vbYesNo, "Continue")
If Response = vbYes Then
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile dbPath & "\" & OldDbName, dbPath & "\" & DbBackup
Set fs = Nothing
Else
If MsgBox("Do You want to Compact This Database And Re-Name As " & vbCrLf & "'" & NewDbName & "'", vbYesNo, "Continue") = vbYes Then
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile dbPath & "\" & OldDbName, dbPath & "\" & DbBackup
DBEngine.CompactDatabase dbPath & "\" & DbBackup, dbPath & "\" & NewDbName
Kill dbPath & "\" & DbBackup
Set fs = Nothing
Else
If MsgBox("Do you want to just compact this Database Only?", vbYesNo, "Continue") = vbYes Then
CommandBars("Menu Bar"). _
Controls("Tools"). _
Controls("Database utilities"). _
Controls("Compact and repair database..."). _
accDoDefaultAction
Else
DoCmd.CancelEvent
End If
End If
End If
End Sub

Watch for line wrapping when copying and pasting the code and add the continue mark as needed.

lwells

Thanks, that worked like a charm.

I just have one more question:

Is it possible to auotmatically open back up to the form after Compact by placing such an action in the code?

Just go to Tools/StartUp and in the dropdown box Display Form/Page select the form that has your command button.

lwells

1. Add a reference to "Microsoft Jet and Replication Objects 2.6 Library"
2. Check if the database is in use , display a warning.
3. Create a temporary folder and copy the DB
4. Create an object of JRO JetEngine and call the compact method , to compact the tempdb and replace at the original location. After compacting delete the temp folder along with its contents.