要完成压缩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
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
解决方案 »
- 新手问一下用VB连接SQL Server的问题
- 在VB下如何创建包含"..\"的文件夹啊
- 谁知道varptr与strptr的区别?到底bstr是什么样指针?
- 关于在Frame控件上放置Label问题。另:按钮焦点问题。
- 使用ADODB.Recordset,如何对ACCESS97的数据库进行新增删除更新记录??急
- 请问!怎样改变listView中被选中时的蓝底色,比如底色变成黄色,还有……
- 求助:程序运行跳出“要求对象”对话框,请问何故?
- PC机与Agilent34401A万用电表之间如何进行RS-232串口通信啊?
- 在对 多表的 连接查询中的 RECORDSET中
- 关于VB7.0
- 在win2000/XP系统下如何锁键盘?
- 一键出招!!应该从哪入手??
这一句不执行是为什么?急!
先谢谢各位了!