当Access文件大于指定的大小时就自动压缩

核心提示：适用 ACCESS2000及以后版本首先在公共模块添加如下函数： 以下为引用的内容：Public Function AutoCompactCurrentProject()Dim fs, f, s, filespecDim strProjectPath As String, strProjectName As Strin

适用 ACCESS2000及以后版本

首先在公共模块添加如下函数：

以下为引用的内容：

　　Public Function AutoCompactCurrentProject()
　　Dim fs, f, s, filespec
　　Dim strProjectPath As String, strProjectName As String
　　strProjectPath = Application.CurrentProject.Path
　　strProjectName = Application.CurrentProject.Name
　　filespec = strProjectPath & "" & strProjectName
　　Set fs = CreateObject("Scripting.FileSystemObject")
　　Set f = fs.GetFile(filespec)
　　s = CLng(f.Size / 1000000)　‘转换文件大小为MB
　　If s > 20 Then　　　　　　　　　　　 ‘修改此处的20M为你自己需要的值
　　　　Application.SetOption ("Auto Compact"), 1　‘压缩程序
　　Else
　　　　Application.SetOption ("Auto Compact"), 0　 ‘不压缩程序
　　End If
End Function

在任何退出的程序前调用这个函数，例如在Docmd.Quit前调用：AutoCompactCurrentProject