Public Sub CloseDBConnect()
' 关闭数据库对象并且释放内存
On Error Resume Next
Dim WS As Workspace
Dim DB As Database
Dim rs As Recordset
For Each WS In Workspaces
For Each DB In WS.Databases
For Each rs In DB.Recordsets
rs.Close
Set rs = Nothing
Next
DB.Close
Set DB = Nothing
Next
WS.Close
Set WS = Nothing
Next
End Sub
Public Sub meCopyMDB()
Static bCopied As Boolean
Static dCopyDate As Date
Dim Source As String
Dim destination As String
Dim strMsg As String
On Error GoTo errCopyMDB
If dCopyDate = Date Then
bCopied = True
Else
bCopied = False
End If
If bCopied Then
MsgBox "今天已经备份过数据库文件了!", vbInformation, "数据备份"
Exit Sub
End If
Source = "mdb\db1.mdb"
destination = "数据库备份\dat1.mdb"
strMsg = "源数据库文件是: " & Source & Chr(13) & Chr(10) _
& "备份数据库文件是:" & destination & Chr(13) & Chr(10) _
& Chr(13) _
& "要备份吗?"
If MsgBox(strMsg, vbYesNo + vbQuestion, "数据备份") = vbNo Then Exit Sub
If Dir(Source) = "" Then '--------------------------------------------- 1.
strMsg = "数据库文件: " & Source & " 丢失.备份失败!" & Chr(13) & Chr(10) _
& "请通知有关人员恢复此文件!"
MsgBox strMsg, vbExclamation, "备份失败!"
Else
If Dir("数据库备份\", vbDirectory) = "" Then '--- 2.
MkDir ("数据库备份\")
MsgBox "在C:盘安装目录建立了一个备份文件夹:数据库备份\", vbInformation, "数据备份"
End If
FileCopy Source, destination
bCopied = True
dCopyDate = Date
MsgBox "备份结束.", vbInformation, "数据备份"
End If '------------------------------------------------------------ 1.
Exit Sub
errCopyMDB:
Call meErr("meCopyMDB")
End Sub
代码应该没问题,有时候也能备份上,有时不可以