Private Sub Command3_Click()
Dim Timenow As String
Dim Sfilename As String
Dim Dfilename As String
Timenow = Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now)
If Level <> 1 Then
MsgBox "你没有操作权限", 0, "注意"
Exit Sub
End If
CommonDialog1.DialogTitle = "请选择备份路径:"
CommonDialog1.Filename = Timenow & "(Backup).mdb"
CommonDialog1.Filter = "*.mdb(Access数据库)|*.mdb"
CommonDialog1.ShowSave
If CommonDialog1.Filename = "" Then Exit Sub
Dfilename = CommonDialog1.Filename
Sfilename = Thispath & "DataBase.mdb"
'读取数据库文件并在新的路径写入
Dim Filenum As Integer
Dim Filenum2 As Integer
Dim i As Integer
Dim n As Long
Dim Leftsize As Long
Dim cells() As Byte
Filenum = FreeFile
Open Sfilename For Binary As Filenum
ProBar.Visible = True
ProBar.Min = 0
ProBar.Max = LOF(Filenum)
n = LOF(Filenum) / 1024
Leftsize = LOF(Filenum) Mod 1024&
Filenum2 = FreeFile
Open Dfilename For Binary As Filenum2
ReDim cells(1024)
For i = 1 To n
Get Filenum, , cells
Put Filenum2, , cells
On Error Resume Next
ProBar.value = ProBar.value + 1024&
DoEvents
Next
If Left > 0 Then
ReDim cells(Left)
Get Filenum, , cells
Put Filenum2, , cells
On Error Resume Next
ProBar.value = ProBar.value + Leftsize&
End If
Close
ProBar.Visible = False
MsgBox "备份完成!", 0, "报告"
End Sub

谢谢大家了

Timenow = Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now)
Timenow =format(now,"yyyymmddhhnnss")这样不就可以了吗?晕!

Private Sub Command3_Click()
Dim Timenow As String//定义字符串变量
Dim Sfilename As String
Dim Dfilename As String
Timenow = Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now)//取当前年月日时分秒组成一个字符串
If Level <> 1 Then//如果leval不等于1，退出函数
MsgBox "你没有操作权限", 0, "注意"
Exit Sub
End If
CommonDialog1.DialogTitle = "请选择备份路径:"//定义通用对话框的标题
CommonDialog1.Filename = Timenow & "(Backup).mdb"//定义保存后的文件名
CommonDialog1.Filter = "*.mdb(Access数据库)|*.mdb"//定义通用对话框的过滤器属性
CommonDialog1.ShowSave//显示通用对话框
If CommonDialog1.Filename = "" Then Exit Sub//如果文件名为空，退出函数
Dfilename = CommonDialog1.Filename//目标文件名
Sfilename = Thispath & "DataBase.mdb"//源文件名
'读取数据库文件并在新的路径写入
Dim Filenum As Integer
Dim Filenum2 As Integer
Dim i As Integer
Dim n As Long
Dim Leftsize As Long
Dim cells() As Byte//定义一个动态数组
Filenum = FreeFile//取得一个可供使用的文件号(打开文件用)
Open Sfilename For Binary As Filenum//以二进制存储方式打开文件
ProBar.Visible = True
ProBar.Min = 0
ProBar.Max = LOF(Filenum)
n = LOF(Filenum) / 1024//取得源文件的大小除以1024的商
Leftsize = LOF(Filenum) Mod 1024&//取得源文件大小除以1024的余数
Filenum2 = FreeFile
Open Dfilename For Binary As Filenum2
ReDim cells(1024)//定义数组的大小为1024
For i = 1 To n
Get Filenum, , cells//取得源文件的1024个字节
Put Filenum2, , cells//将取得的1024个字节存入目标文件中
On Error Resume Next//遇到错误继续
ProBar.value = ProBar.value + 1024&
DoEvents
Next
//以下为如果余数不为零，则将源文件中剩余的数据取出并存入目标文件
If Left > 0 Then
ReDim cells(Left)
Get Filenum, , cells
Put Filenum2, , cells
On Error Resume Next
ProBar.value = ProBar.value + Leftsize&
End If
Close
ProBar.Visible = False
MsgBox "备份完成!", 0, "报告"
End Sub

谢谢楼上的大哥
小弟万分感谢！！！！