＋设为首页 ＋添加到收藏夹
在vb程序中，如何实现对access的备份？备份的时候，有用户自行决定是选择哪个目录！
FileCopy "c:\db.mdb", "d:\dbbak.mdb"
拷贝数据库文件就可以了
Public Sub CompactJetDatabase(Location As String, Optional BackupOriginal As Boolean = True)
On Error GoTo CompactErr
Dim strBackupFile As String
Dim strTempFile As String
Conn.Close
检查数据库文件是否存在
If Len(Dir(Location)) Then
如果需要备份就执行备份
If BackupOriginal = True Then
strBackupFile = App.Path & "\backup.mdb"
If Len(Dir(strBackupFile)) Then Kill strBackupFile
FileCopy Location, strBackupFile
End If
创建临时文件名
strTempFile = App.Path & "\temp.mdb"
If Len(Dir(strTempFile)) Then Kill strTempFile
通过DBEngine 压缩数据库文件
DBEngine.CompactDatabase Location, strTempFile
删除原来的数据库文件
Kill Location
拷贝刚刚压缩过临时数据库文件至原来位置
FileCopy strTempFile, Location
删除临时文件
Kill strTempFile
Else
End If
Conn.Open StrConn
CompactErr:
Exit Sub
End Sub
*********************************************************
* 名称：BackupDatabase
* 功能：备份数据库
* 控件：一个文本框和两个按钮
*********************************************************
Public Sub BackupDatabase()
Dim cn As New ADODB.Connection
Dim s_path, s_dataexport As String
s_path = App.Path
Me.MousePointer = 11 设置鼠标指针形状
student1是需要备份的数据库名称
s_dataexport = "backup database student1 to disk=" + CommonDialog1.FileName + ""
cn.Open "driver={sql server};server=" & d1 & ";database=student1;persist security info=false; userid=sa" 数据库连接字符串
这里不需要连接master数据库，即可完成备份
cn.BeginTrans
cn.Execute s_dataexport
Err.Number = 0
If Err.Number = 0 Then
cn.CommitTrans
MsgBox "数据备份成功！", vbInformation, "提示"
MsgBox "数据备份文件存放路径:" & CommonDialog1.FileName, vbOKOnly, "提示"
Unload Me
Else
cn.RollbackTrans
MsgBox "数据备份失败！请检查数据库是否正在打开！", vbCritical, "提示"
End If
cn.Close
Set cn = Nothing
Me.MousePointer = 1
End Sub
*********************************************************
* 名称：RestoreDataBase
* 功能：还原数据库
* 控件：一个文本框和两个按钮
*********************************************************
Public Sub RestoreDataBase()
If Text1.Text = "" Then
MsgBox "请选择要恢复的数据文件！", vbInformation, "提示"
Exit Sub
Else
ret = MsgBox("数据恢复操作将会覆盖以前的所有数据并且覆盖后无法恢复，您确定要进行恢复操作吗？", vbQuestion + vbOKCancel, "提示")
If ret = vbOK Then
Dim cn As New ADODB.Connection
Dim sn As New ADODB.Recordset
Dim s_restore As String
Me.MousePointer = 11
cn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;server=" & d1 & ";Initial Catalog=master;Data Source=127.0.0.1;user id=sa;password=" & d3 & ""
sn.Open "select spid from sysprocesses where dbid=db_id(student1)", cn
Do While Not sn.EOF
cn.Execute "kill " & sn("spid")
sn.MoveNext
Loop
sn.Close
s_restore = "restore database student1 from disk=" + Trim(Text1.Text) + " with REPLACE"
cn.Execute s_restore
Debug.Print gs_conn_string
此时需要连接master数据库才能完成数据恢复操作
同上student1为需要恢复的数据库
s_restore = "restore database student1 from disk=" + Trim(Text1.Text) + ""
text1一个用于记录需要恢复文件的地址的textbox
cn.Execute s_restore
cn.BeginTrans
If Err.Number = 0 Then
cn.CommitTrans
MsgBox "数据恢复成功！", vbInformation, "提示"
Command1.Enabled = True
Label1.Visible = False
Else
cn.RollbackTrans
MsgBox "数据恢复失败！", vbCritical, "提示"
Command1.Enabled = True
End If
cn.Close
Set cn = Nothing
Me.MousePointer = 1
Else
Exit Sub
End If
On Error Resume Next
Dim DBC As New DataBaseConnection
If db.State = 1 Then
db.Close
End If
db.ConnectionString = DBC.SqlConnectString(d1, d2, d3)
rs.CursorType = adOpenDynamic
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
db.CursorLocation = adUseClient
db.Open
Set cmd.ActiveConnection = db
If Err.Number Then
MsgBox Err.Description, 16 + vbOKOnly, Err.Number
Exit Sub
End If
db.DefaultDatabase = "student1"
If Err.Number Then
MsgBox Err.Description, 16 + vbOKOnly, Err.Number
Exit Sub
End If
End If
End Sub
这是备份SQL 数据库
你改改!
Private Sub ComBackup_Click()
Dim n As Integer
Text1 = ""
With CommonDialog1
.FileName = "数据库名.mdb"
.Filter = "*.mdb|*.mdb"
.CancelError = True
.Flags = 4
.InitDir = "::{注册表....},MyDocuments"
On Error GoTo errexit
again:
.ShowSave
If .FileName = App.Path & "\数据库名.mdb" Then
MsgBox "请选择源数据库文件以外的路径"
GoTo again
End If
Me.Refresh
On Error GoTo 0
Text1 = .FileName
If Len(Dir(.FileName)) Then
If MsgBox("选定路径下备份文件已经存在，确定将覆盖现有文件。", vbQuestion + vbOKCancel) = vbOK Then
Kill .FileName
n = 0
Do Until Dir(.FileName) = ""
n = n + 1
If n = 10 Then GoTo errexit
Loop
Else
Text1 = ""
GoTo errexit
End If
End If
DBEngine.CompactDatabase App.Path & "\数据库名.mdb", .FileName, , ,
MsgBox "备份成功。文件已经压缩至 " & FileLen(.FileName) & " 字节"
End With
errexit:
End Sub
你用api 函数吧copyfile
