Komprese databáze

Postup:
Do projektu je třeba přidat referenci na MS DAO Library. Pokud máte databázi ve formátu MS Access 2000, je třeba verze 3.6.
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

   'Test existence databáze
   If Len(Dir(Location)) Then

' Pokud je požadován backup ...
    If BackupOriginal = True Then
    strBackupFile = GetTemporaryPath & "backup.mdb"
    If Len(Dir(strBackupFile)) Then Kill strBackupFile
    FileCopy Location, strBackupFile
    End If

' Vytvoření dočasného souboru
    strTempFile = GetTemporaryPath & "temp.mdb"
    If Len(Dir(strTempFile)) Then Kill strTempFile

' Komprese databáze
    DBEngine.CompactDatabase Location, strTempFile

' Smazání původního souboru
    Kill Location

' Nakopírování dočasné, zkompresované databáze
    FileCopy strTempFile, Location

' Smazání dočasného souboru
    Kill strTempFile

   Else

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

Použití:
Call CompactJetDatabase("e:\bozena.mdb")

Zpět