Compacting Databases

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