要完成压缩MDB数据库的功能,但为什么到了 DBEngine.CompactDatabase Location, strTempFile一句就不执行了?程序不提示任何错误.
windows xp+vb6.0环境
代码如下:Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Const MAX_PATH = 260Public 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
  MsgBox "压缩完成"
Else
 
End If
CompactErr:
Exit Sub
End SubPublic 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