在VB中怎样备份access数据库?

[sundy_RAO]

请问：在VB中怎样备份access数据库?

[gump2000]

filecopy
用copy吧:)

[gump2000]

Option Explicit

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdIn_Click()
CDialog.DialogTitle = "请选择巡更备份文件"
CDialog.Filter = "巡更备份文件(*.XGB)|*.XGB"
CDialog.FilterIndex = 1
CDialog.InitDir = "c:\"
CDialog.Flags = cdlOFNHideReadOnly
CDialog.ShowOpen
txtIn.Text = CDialog.Filename
End Sub

Private Sub cmdOk_Click()
If TabStrip1.SelectedItem.Index = 1 Then
' 导入文件
If txtIn.Text = "" Then
MsgBox "请选择备份文件！", vbExclamation, "提示"
Exit Sub
End If
If Not FileExists(txtIn.Text) Then
MsgBox "文件 " & txtIn.Text & " 不存在！", vbCritical, "错误"
Exit Sub
End If
If Not CheckFile Then
MsgBox txtIn.Text & "不是巡更备份文件！", vbCritical, "错误"
Exit Sub
End If
If MsgBox("导入备份以后，以前的备份将被覆盖，是否继续？", vbQuestion + vbYesNo, "提示") = vbNo Then Exit Sub
On Error GoTo in_err
BACKCnn.Close
If FileExists(BACKDATABASE & ".BAK") Then Kill BACKDATABASE & ".BAK"
Name BACKDATABASE As BACKDATABASE & ".BAK"
FileCopy txtIn.Text, BACKDATABASE
If BACKCnn.State = adStateClosed Then BACKCnn.Open BackUpCnnString
MsgBox "备份文件导入成功！", vbExclamation, "提示"
Unload Me
Exit Sub
in_err:
MsgBox "备份文件导入错误！错误代码：" & vbCrLf & Error(Err), vbCritical, "错误"
If BACKCnn.State = adStateClosed Then BACKCnn.Open BackUpCnnString
If (Not FileExists(BACKDATABASE)) And FileExists(BACKDATABASE & ".BAK") Then Name BACKDATABASE & ".BAK" As BACKDATABASE
Exit Sub

Else

'导出文件
If txtOut.Text = "" Then
MsgBox "请输入备份文件名！", vbExclamation, "提示"
Exit Sub
End If
If FileExists(txtOut.Text) Then
If MsgBox(txtOut.Text & "已经存在，是否要覆盖？", vbQuestion + vbYesNo, "提示") = vbNo Then Exit Sub
On Error GoTo out_err
Kill txtOut.Text
End If
BACKCnn.Close
FileCopy BACKDATABASE, txtOut.Text
If BACKCnn.State = adStateClosed Then BACKCnn.Open BackUpCnnString
MsgBox "备份文件导出成功！", vbExclamation, "提示"
Unload Me
Exit Sub
out_err:
MsgBox "备份文件导出错误！错误代码：" & vbCrLf & Error(Err), vbCritical, "错误"
If BACKCnn.State = adStateClosed Then BACKCnn.Open BackUpCnnString
Exit Sub
End If
End Sub

Private Sub cmdOut_Click()
CDialog.DialogTitle = "请输入巡更备份文件名"
CDialog.Filter = "巡更备份文件(*.XGB)|*.XGB"
CDialog.FilterIndex = 1
CDialog.InitDir = "c:\"
CDialog.Flags = cdlOFNHideReadOnly
CDialog.Filename = txtOut.Text
CDialog.ShowSave
txtOut.Text = CDialog.Filename
End Sub

Private Sub Form_Load()
txtOut.Text = "C:\" & Format(Date, "yyyyMMdd") & ".XGB"
End Sub

Private Sub TabStrip1_Click()
FrameInOut(0).Move 400, 630
FrameInOut(1).Move 400, 630
FrameInOut(0).Visible = False
FrameInOut(1).Visible = False
FrameInOut(TabStrip1.SelectedItem.Index - 1).Visible = True
End Sub

Private Function CheckFile() As Boolean
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset

On Error GoTo open_err
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & txtIn.Text & _
";Persist Security Info=False;Jet OLEDB:Database Password=" & DataBasePWD

rs.Open "备份信息", cnn
rs.Close
cnn.Close
CheckFile = True
Exit Function
open_err:
On Error Resume Next
CheckFile = False
If rs.State = adStateOpen Then rs.Close
If cnn.State = adStateOpen Then cnn.Close
End Function

[setfocus]

用FSO的copy！
On Error Resume Next
Dim fso As FileSystemObject
Dim fstr As File
CommonDialog1.Filter = "*.mdb"

CommonDialog1.ShowOpen
Set fso = New FileSystemObject

Set fstr = fso.GetFile(CommonDialog1.FileName)

fstr.Copy "&app.path&", True

[vbsnake]

拷贝有两种

一种不需要关闭数据库
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
或
是必须关闭数据库
filecopy

[年糕]

filecopy当数据库关闭的时候是可以的

[DragonCity]

同意 vbsnake(泡泡龙) 所说的！
当多用户使用（打开）同一个Access库时（例如用户公司营业时间内），也要能备份才行。记得除了SHFileOperation 之外，还有一个API函数可以达到这个要求，好像是下面的函数：
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
可以拷贝已经打开的数据库文件。

另外，如果对你有帮助，请回复我的一个帖子：
http://www.csdn.net/expert/topic/654/654811.xml?temp=.8152735
主题： 我自认VB水平不错，请大家给我估估价！

[sundy_RAO]

首先感谢各位！
但我的ACCESS数据库是在使用中的，用filecopy可以备份吗？该怎样做呢？

[vbsnake]

当数据库打开时是不允许用filecopy
如果你想可以用
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

[sundy_RAO]

非常感谢各位的帮助! 谢谢!!