改写代码

[vfpbu]

求做一个数据库access备份的窗体

要求：就是把先打开正在使用的数据库，并显示其位置
然后打开要保存到的位置。单击“开始备份”命令按钮，执行备份命令。


窗体上所有控件：一个“开始备份”命令按钮，一个对话框（用于选择当前使用数据库的位置），一个对话框（选择要保存到的位置）,一个“取消”命令按钮。注：可以根据改写需要自行添加控件。


代码：把下面代码改一下就可以了，改成如上要求。

'用VB编写自动备份文件程序
--------------------------------------

Public Sub BackupFile(Filename As String, Drive As String, Folder As String)
Dim Fso As New FileSystemObject '创建 FSO 对象实例
Dim Dest_path As String, Counter As Long
Dim StrDay As String, StrMonth As String, NewFilename As String

Counter = 0
Do While Counter < 6 '如果驱动器没准备好，继续检测。共检测 6 秒
Counter = Counter + 1
Call Waitfor(1) '间隔 1 秒
If Fso.Drives(Drive).IsReady = True Then
Exit Do
End If
Loop
If Fso.Drives(Drive).IsReady = False Then '6 秒后目标盘仍未准备就绪，退出
MsgBox " 目标驱动器 " & Drive & " 没有准备好！ ", vbCritical
Exit Sub
End If
If Fso.GetDrive(Drive).FreeSpace < Fso.GetFile(Filename).Size Then
MsgBox "目标驱动器空间太小！", vbCritical '目标驱动器空间不够，退出
Exit Sub
End If
If Right(Drive, 1) <> ":" Then
Drive = Drive & ":"
End If
If Left(Folder, 1) <> "\" Then
Folder = "\" & Folder
End If
If Right(Folder, 1) <> "\" Then
Folder = Folder & "\"
End If
If Day(Date) < 10 Then
StrDay = "0" & Day(Date)
Else
StrDay = Day(Date)
End If
If Month(Date) < 10 Then
StrMonth = "0" & Month(Date)
Else
StrMonth = Month(Date)
End If
'Fso.FileExists ()
NewFilename = "newfilename"
Dest_path = Drive & Folder
If Not Fso.FolderExists(Dest_path) Then '如果目标文件夹不存在，创建之
Fso.CreateFolder Dest_path
End If
Fso.CopyFile Filename, Dest_path & NewFilename, True
'拷贝，直接覆盖同名文件
Set Fso = Nothing
End Sub
Private Sub Waitfor(Delay As Single) '延时过程，Delay 单位约为 1 秒
Dim StartTime As Single
StartTime = Timer
Do Until (Timer - StartTime) > Delay
Loop
End Sub

Private Sub Form_Load()
BackupFile "filename", "d:", "filebackupdir"
End
End Sub

[神马被哪个妞占用了呢]

[Q724481678Q]

自己都说代码改一下就可以，怎么不自己做呀

[dbcontrols]

是啊，都是些基本的问题

[Quote=引用 1 楼 wsz1997 的回复:]
自己都说代码改一下就可以，怎么不自己做呀
[/Quote]