В проект вложим References для MS DAO Library
| Код |
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
' если существует БД
If Len(Dir(Location)) Then
' Если надо бэкапит файл
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
' Сделать компресию БД
DBEngine.CompactDatabase Location, strTempFile
' Стереть файл с базой данных
Kill Location
' Копирование временной баззы даных
FileCopy strTempFile, Location
' Стереть временный файл
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
|
Употребление:
| Код |
Call CompactJetDatabase("e:\001.mdb")
|
|