求助：如何在vb中压缩不断膨胀的Access数据库

liuhaixiao 2001-10-29 10:03:01

各位朋友，我做一个工业监测软件，使用vb开发，access做后台数据库，可是随着对数据库的修改，数据库膨胀的令人不可思议，如何才能解决这个问题？

...全文

47 点赞收藏 4

写回复

4 条回复

切换为时间正序

当前发帖距今超过3年，不再开放新的回复

发表回复

foolishtiger 2001-10-29

楼上的两个贴子都不能从根本上解决问题,我以前也碰到过这种问题,最后实在没办法只有移植到SQL Server 了.可能要问一下微软才有权威的答案.

回复赞

baoxiang 2001-10-29

　　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 BackOriginal As Boolean = True)
　　On Error GoTo CompactErr
　　Dim strBackFile As String
　　Dim strTempFile As String
　　'检查数据库文件是否存在
　　If Len(Dir(Location)) Then
　　 ' 如果需要备份就执行备份
　　 If BackOriginal = True Then
　　 strBackFile = GetTemporaryPath & "Back.mdb"
　　 If Len(Dir(strBackFile)) Then Kill strBackFile
　　 FileCopy Location, strBackFile
　　 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
　　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

回复赞