• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• Compacting Databases

Compacting Databases

The problem with Access databases is that when you delete records, the .MDB file doesn't shrink.
It just grows and grows and grows – until someone either compacts it or you run out of disk space.
This tip will show you how to compact a JET database up to 100 times!

Inputs
Simply run CompactDatabase passing the location of your database. There's also an optional argument requiring a True or False value to backup the original database to the Temp directory before proceeding.

Assumes
Note: In order for this to work, you need a reference (Project, References) to any version of the Microsoft DAO object library.

Returns
Substantially smaller Database (e.g. 25.3 mb to 4.7 mb).

API Declarations
Public Declare Function GetTempPath Lib "kernel32" Alias _
"GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer _
As String) As Long
Public Const MAX_PATH = 260


Rate Compacting Databases

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

Public Sub CompactDatabase(Location As String, _
 Optional BackupOriginal As Boolean = True)
On Error GoTo CompactErr
 
Dim strBackupFile As String
Dim strTempFile As String
'Check the database exists
If Len(Dir(Location)) Then
	' Create Backup
	If BackupOriginal = True Then
		strBackupFile = GetTemporaryPath & "backup.mdb"
		If Len(Dir(strBackupFile)) Then Kill strBackupFile
		FileCopy Location, strBackupFile
	End If
	strTempFile = GetTemporaryPath & "temp.mdb"
	If Len(Dir(strTempFile)) Then Kill strTempFile
	' Do the compacting 
  'DBEngine is a reference to the Microsoft DAO Object Lib...
	DBEngine.CompactDatabase Location, strTempFile
	' Remove the uncompressed database
	Kill Location
	' Replace Uncompressed
	FileCopy strTempFile, Location
	Kill strTempFile
End If
CompactErr:
 Exit Sub
End Sub
Public Function GetTemporaryPath()
Dim strFolder As String
Dim lngResult As Long
strFolder = String(MAX_PATH, 0)
lngResult = GetTempPath(MAX_PATH, strFolder)
If lngResult <> 0 Then
 GetTemporaryPath = Left(strFolder, InStr(strFolder, _
	Chr(0)) - 1)
Else
 GetTemporaryPath = ""
End If
End Function