改写代码
求做一个数据库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 LongDim StrDay As String, StrMonth As String, NewFilename As StringCounter = 0Do While Counter < 6 '如果驱动器没准备好，继续检测。共检测 6 秒Counter = Counter + 1Call Waitfor(1) '间隔 1 秒If Fso.Drives(Drive).IsReady = True ThenExit DoEnd IfLoopIf Fso.Drives(Drive).IsReady = False Then '6 秒后目标盘仍未准备就绪，退出MsgBox " 目标驱动器 " & Drive & " 没有准备好！ ", vbCriticalExit SubEnd IfIf Fso.GetDrive(Drive).FreeSpace < Fso.GetFile(Filename).Size ThenMsgBox "目标驱动器空间太小！", vbCritical '目标驱动器空间不够，退出Exit SubEnd IfIf Right(Drive, 1) <> ":" ThenDrive = Drive & ":"End IfIf Left(Folder, 1) <> "\" ThenFolder = "\" & FolderEnd IfIf Right(Folder, 1) <> "\" ThenFolder = Folder & "\"End IfIf Day(Date) < 10 ThenStrDay = "0" & Day(Date)ElseStrDay = Day(Date)End IfIf Month(Date) < 10 ThenStrMonth = "0" & Month(Date)ElseStrMonth = Month(Date)End If'Fso.FileExists ()NewFilename = "newfilename"Dest_path = Drive & FolderIf Not Fso.FolderExists(Dest_path) Then '如果目标文件夹不存在，创建之Fso.CreateFolder Dest_pathEnd IfFso.CopyFile Filename, Dest_path & NewFilename, True'拷贝，直接覆盖同名文件Set Fso = NothingEnd SubPrivate Sub Waitfor(Delay As Single) '延时过程，Delay 单位约为 1 秒Dim StartTime As SingleStartTime = TimerDo Until (Timer - StartTime) > DelayLoopEnd SubPrivate Sub Form_Load()BackupFile "filename", "d:", "filebackupdir"EndEnd Sub
