by Bradley Liang (6 Submissions)
Category: Databases/Data Access/DAO/ADO
Compatability: Visual Basic 3.0
Difficulty: Intermediate
Date Added: Wed 3rd February 2021
Rating: 
(2 Votes)
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.
Code Returns
Substantially smaller Database (e.g. 25.3 mb to 4.7 mb).
API DeclarationsPublic Declare Function GetTempPath Lib "kernel32" Alias _
"GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer _
As String) As Long
Public Const MAX_PATH = 260
VBcodersPublic 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
