在Access数据库操作时经常数据库经常会由于操作频繁而出现各种问题.以及数据库无限的增大.为了不影响使用我们需要对数据库进行压缩/修复.以下代码就是用VB压缩并且修复Access数据库德 代码.大家可以直接使用.
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 压缩数据库文件
DBEngine.CompactDatabase Location, strTempFile
' 删除原来的数据库文件
Kill Location
' 拷贝刚刚压缩过临时数据库文件至原来位置
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
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 压缩数据库文件
DBEngine.CompactDatabase Location, strTempFile
' 删除原来的数据库文件
Kill Location
' 拷贝刚刚压缩过临时数据库文件至原来位置
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