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!
Original Author: Bradley Liang
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.
Assumptions
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
Code
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
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.