VBGood网站全文搜索 Google

首页 - 经验之谈 - 压缩数据库
发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:10759, 日期:2001-04-12
Compressing a Database

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 your Jet database... in code!

Simply run the CompactJetDatabase method from the below code snippet, passing the location of your database. There注释:s also an optional argument requiring a True or False value, depending on whether you want to backup the original database to the Temp directory before proceeding.

This code works by running the CompactDatabase method of the DBEngine object, part of the Microsoft DAO library.

I tried this on a database I注释:d been using for a couple of months. It zapped down from 21.6MB to a mere 300KB.

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


Call CompactJetDatabase("e:\sites\sahara\content.mdb")Code

注释: Code to be used in a module

Public Declare Function GetTempPath Lib "kernel32" Alias _
    "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer _
    As String) As Long

Public Const MAX_PATH = 260

Public Sub CompactJetDatabase(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

注释: If a backup is required, do it!
If BackupOriginal = True Then
strBackupFile = GetTemporaryPath & "backup.mdb"
If Len(Dir(strBackupFile)) Then Kill strBackupFile
FileCopy Location, strBackupFile
End If

注释: Create temporary filename
strTempFile = GetTemporaryPath & "temp.mdb"
If Len(Dir(strTempFile)) Then Kill strTempFile

注释: Do the compacting via DBEngine
DBEngine.CompactDatabase Location, strTempFile

注释: Remove the original database file
Kill Location

注释: Copy the temporary now-compressed
注释: database file back to the original
注释: location
FileCopy strTempFile, Location

注释: Delete the temporary file
Kill strTempFile


End If

    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)
  GetTemporaryPath = ""
End If

End Function