Office中国论坛/Access中国论坛

标题: ACCESS通用系统用2003升到2007后遇到的问题 [打印本页]

作者: yanghuap 时间: 2011-3-2 21:37
标题: ACCESS通用系统用2003升到2007后遇到的问题
本帖最后由 yanghuap 于 2011-3-2 21:44 编辑

在使用红尘如烟的ACCESS通用系统用过程中，因ACCESS版本不同，将原来的ACCESS2003版升级到access2007版后，备份与数据还原功能不能用了，原因是ACCESS2007不支持Application.FileSearch，请问以下备份代码应该怎么修改？多谢热心人的指教，不胜感激！(应该只改红允的部分就可以了吧？)

Option Explicit

'备份方式常量枚举
Public Enum conBackupMode
conBackupModeSaveAll = 0 '保留所有备份
conBackupModeSaveEveryDay = 1 '每天保留一个备份
conBackupModeSaveEveryMonth = 2 '每月保留一个备份
End Enum

'备份后台数据库文件
Public Function BackupData() As Boolean
On Error GoTo Err_BackupData

Dim strBackupDir As String '备份目录路径
Dim strSource As String '要备份的源文件名
Dim strDestination As String '生成的备份文件名
Dim lngBackupMode As Long '自动备份模式
Dim lngMaxQty As Long '允许最大备份数量
Dim frm As Form
Dim intI As Integer

'如果用户取消确认，则退出不进行备份
If GetDbSetting("ConfirmBeforeBackup", False) Then
If MsgBox("是否备份资料？", vbQuestion + vbYesNo) = vbNo Then Exit Function
End If

CurrentDb.close

'取得后台数据库文件路径名
strSource = GetDbSetting("DataFileName", "")
If Not strSource Like "[A-z]:\*" Then strSource = CurrentProject.Path & "\" & strSource

'取得备份目录路径名
strBackupDir = GetDbSetting("BackupDir", "备份\")
If Not strBackupDir Like "[A-z]:*" Then strBackupDir = CurrentProject.Path & "\" & strBackupDir
If Not FolderExists(strBackupDir) Then strBackupDir = CreateDir(strBackupDir)

'取得备份文件路径名
strDestination = Mid$(strSource, InStrRev(strSource, "\") + 1)
strDestination = strBackupDir & Format$(Now(), "yyyy-mm-dd hh.nn_") & strDestination & ".bak"

With Application.FileSearch
.NewSearch
.LookIn = strBackupDir
.SearchSubFolders = False
'如果已有备份文件数量加1大于允许的最大备份数量，则删除多出来的早期档
lngMaxQty = GetDbSetting("MaxBackFileQuantity", 0)
.FileName = "*.bak"
If .Execute > 0 And lngMaxQty > 0 Then
If .FoundFiles.Count + 1 > lngMaxQty Then
For intI = 1 To (.Execute + 1 - lngMaxQty)
Kill .FoundFiles(intI)
Next
End If
End If '
'根据备份模式删除已有的备份文件（例如备份模式为每天一个备份，如果当天已经进行过备份，
'则再次备份时之前的备份文件会被删除）
lngBackupMode = GetDbSetting("BackupMode", conBackupModeSaveAll)
Select Case lngBackupMode
Case conBackupModeSaveAll
.FileName = Format$(Now(), "yyyy-mm-dd hh.nn") & "*.bak"
Case conBackupModeSaveEveryDay
.FileName = Format$(Now(), "yyyy-mm-dd") & "*.bak"
Case conBackupModeSaveEveryMonth
.FileName = Format$(Date, "yyyy-mm") & "*.bak"
End Select
If .Execute > 0 Then
For intI = 1 To .FoundFiles.Count
Kill .FoundFiles(intI)
Next
End If
End With
'进行备份操作（复制一个后台数据库文件到备份目录并按照备份文件命名规则重新命名）
FileCopy strSource, strDestination
If Err.Number = 0 Then BackupData = True

Exit_BackupData:
Exit Function

Err_BackupData:
BackupData = False
Select Case Err.Number
Case 53
MsgBox "未指定要备份的源文件。", vbCritical
Case 70
MsgBox "后台数据库被其它用户或您自己以独占方式打开，现在不能进行备份。", vbCritical
Case 71
MsgBox "指定的备份目录所在磁盘可能为读卡器，现在未连接存储卡，不能写入备份文件。", vbCritical
Case 75
MsgBox "当前登录操作系统的用户没有删除文件的权限，不能替换已有备份。", vbCritical
Case Else
MsgBox Err.Description, vbCritical
End Select
Resume Exit_BackupData

End Function

作者: zhuyiwen 时间: 2011-3-2 23:06
你可以试着用 Dir 函数替代 Application.FileSearch

作者: zhuyiwen 时间: 2011-3-2 23:55
[attach]44974[/attach]

Application.FileSearch 的替代示例：
http://dfenton.com/DFA/download/Access/FileSearch.zip

作者: yanghuap 时间: 2011-3-3 17:15
謝謝 zhuyiwen 管理員的熱心幫助，不過你的這個示例看得我好辛苦，還沒有弄懂。

作者: zhuyiwen 时间: 2011-3-5 14:23
首先声明，这不是我的代码

不过外国佬写代码很严谨，值得学习。

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)