ACCESS数据库自动备份怎么实现?大神们帮帮忙
发布网友
发布时间：2022-04-24 00:14
共1个回答
热心网友
时间：2022-04-11 20:22
用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
