Private Const FO_COPY = &H1
Private Const FO_MOVE = &H2
Private Const FO_DELETE = &H3
Private Const FO_RENAME = &H3
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_SILENT = &H4
Private Const FOF_NOERRORUI = &H400
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String ' only used if FOF_SIMPLEPROGRESS
End Type
Public Function CopyFile(ByVal sFrom As String,ByVal sTo As String) As Boolean
Dim udtPath As SHFILEOPSTRUCT
udtPath.hwnd = 0
udtPath.wFunc = FO_COPY
udtPath.pFrom = sFrom
udtPath.pTo = sTo
udtPath.fFlags = FOF_NOCONFIRMATION 'Or FOF_SILENT Or FOF_NOERRORUI
CopyFile= Not CBool(SHFileOperation(udtPath))
End Function
Private Sub cmdNext_Click()
On Error Resume Next
If Dir(Trim(txtPath.Text), vbDirectory) = "" Then
MsgBox "请检查路径是否正确,或者按浏览按钮。", vbOKOnly + 32, "路径错误..."
Exit Sub
End If
On Error GoTo 0
Dim TempFile As String, ObjectFile As String
TempFile = App.Path & "\data\data.mdb"
If Dir(TempFile) = "" Then
MsgBox "数据文件遭破坏,不能备份。", vbOKOnly + 16, "警告..."
txtPath.Enabled = False
cmdNext.Enabled = False
cmdBrowser.Enabled = False
Exit Sub
End If
ObjectFile = Trim(txtPath.Text)
If Right(ObjectFile, 1) <> "\" Then
ObjectFile = ObjectFile + "\"
End If
ObjectFile = ObjectFile + "data.mdb"
If Dir(ObjectFile) <> "" Then
If UCase(ObjectFile) = UCase(TempFile) Then
MsgBox "备份目录不能与源目录相同!", vbOKOnly + 32, "注意..."
Exit Sub
End If
Dim YN As Integer
YN = MsgBox("该目录下已经存在备份文件,要覆盖吗?(Y/N)", vbYesNo + 16, "警告...")
If YN = 6 Then
Kill ObjectFile
Else
Exit Sub
End If
End If