module1.bas

用Visual Basic编写的压缩Access文件软件

Attribute VB_Name = "Module1"

'调用API函数获取文件所在的临时路径
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, _
                        ByVal lpBuffer As String) As Long
Public Const MAX_PATH = 260

Public CompactFile As String
Public Sub CompactJetDatabase(Location As String, Optional BackupOriginal As Boolean = True)
Dim strBackupFile As String
Dim strTempFile As String
On Error GoTo CompactErr

'检查数据库文件是否存在
    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 压缩数据库文件并生成一个新的临时temp.mdb文件在C:\Documents and Settings\Administrator\Local Settings\Temp目录下
        DBEngine.CompactDatabase Location, strTempFile
        ' 删除原来的数据库文件
        Kill Location
        ' 拷贝刚刚压缩过临时数据库文件至原来位置
        FileCopy strTempFile, Location
        ' 删除临时文件
       Kill strTempFile
    Else
    End If
CompactErr:
      Exit Sub
End Sub

'获取临时路径C:\Documents and Settings\Administrator\Local Settings\Temp
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 Sub EnterTab(KeyAsciiValue As Integer)
    If KeyAsciiValue = 13 Then
        SendKeys "{TAB}"
    End If
End Sub