********************************************************* '* 名称: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 '''''''''''''''''''''''''''''''''''''''''''''如果当前没有与要恢复的数据库立连接,则不需要加单引号中的内容。如果希望恢复数据库之后继续建立连接,则需要写这部分代码。我要恢复数据库名称为student1,备份数据库的时候是在连接状态下进行的,但是恢复数据库不可以在数据库存在连接的状态下进行操作!代码的解决方法是:先连接SQL Server中主库master 库,在该库中的sysprocesses表中存放着所有连接到此数据库的连接信息,将这些连接信息用Kill语句删除。然后再恢复数据库student1,由于用Kill语句后,数据库已经被断开,所以在恢复完成后,再用系统最初的连接数据库代码连接上数据库student1。
'------------------------------------------------------------------ ' 代码描述:SQL Server数据库的备份与恢复 ' ' 注意事项:1.需要在工程中引用Microsoft SQLDMO Object Library ' 2.备份/恢复数据库时,要保证没有其它用户连接到SQL Server ' ' 窗体控件:2个Command,名称分别为cmdBackup,cmdRestore ' 1个Label,名称为lblProgress,用于显示备份/恢复进程。'------------------------------------------------------------------ ' Option ExplicitPrivate WithEvents objBackup As SQLDMO.Backup Private WithEvents objRestore As SQLDMO.RestorePrivate Sub cmdBackup_Click() Dim objSQLServer As New SQLDMO.SQLServer Dim strServer As String Dim strUserID As String Dim strPassword As String Dim strDatabase As String Dim strFile As String
Set objBackup = New SQLDMO.Backup With objBackup .PercentCompleteNotification = 1 .Database = strDatabase .Files = strFile .SQLBackup objSQLServer End With Set objBackup = Nothing
objSQLServer.Close Set objSQLServer = Nothing
Screen.MousePointer = 0 Exit Sub
ErrorHandler: Screen.MousePointer = 0 MsgBox Err.Description, vbCritical End SubPrivate Sub cmdRestore_Click() Dim objSQLServer As New SQLDMO.SQLServer Dim strServer As String Dim strUserID As String Dim strPassword As String Dim strDatabase As String Dim strFile As String
Set objRestore = New SQLDMO.Restore With objRestore .PercentCompleteNotification = 1 .Database = strDatabase .ReplaceDatabase = True .Files = strFile .SQLRestore objSQLServer End With Set objRestore = Nothing
objSQLServer.Close Set objSQLServer = Nothing
Screen.MousePointer = 0 Exit Sub
ErrorHandler: Screen.MousePointer = 0 MsgBox Err.Description, vbCritical End SubPrivate Sub objBackup_Complete(ByVal Message As String) lblProgress.Caption = "备份成功!" Set objBackup = Nothing End SubPrivate Sub objBackup_PercentComplete(ByVal Message As String, ByVal Percent As Long) lblProgress.Caption = "备份进度: " & Percent & "%" DoEvents End SubPrivate Sub objRestore_Complete(ByVal Message As String) lblProgress.Caption = "恢复成功!" Set objRestore = Nothing End SubPrivate Sub objRestore_PercentComplete(ByVal Message As String, ByVal Percent As Long) lblProgress.Caption = "恢复进度: " & Percent & "%" DoEvents End Sub
'备份数据库'需要添加一个commoldialog控件 Sub backDataBase() On Error GoTo errnum dlg.CancelError = True Cn1.Execute "use master" dlg.Filter = "(*.bak)|*.bak" dlg.ShowSave MousePointer = 11 Cn1.Execute "BACKUP DATABASE kffgl TO DISK = '" & dlg.FileName & "'" '备份数据库 MousePointer = 0 Set Cn1 = Nothing '重新建立连接 errnum:
Call dbint Set Cn1 = New ADODB.Connection Cn1.Open "Driver={SQL Server};Server=" & SQL_SRV & ";Uid=" & SA & ";Pwd=" & PA & ";Database=" & SJK & "" End Sub
'得到还原后的数据库存放目录,如果没有指定,存放到SQL SERVER的DATA目录 If sDataBasePath = "" Then iSql = "select filename from master..sysfiles" iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly iSql = iRe(0) iRe.Close sDataBasePath = Left(iSql, InStrRev(iSql, "\")) End If
'检查数据库是否存在 If sReplaceExist = False Then iSql = "select 1 from master..sysdatabases where name='" & sDataBaseName & "'" iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly If iRe.EOF = False Then iReturn = "数据库已经存在!" iRe.Close GoTo lbExit End If iRe.Close End If
'* 名称: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 '''''''''''''''''''''''''''''''''''''''''''''如果当前没有与要恢复的数据库立连接,则不需要加单引号中的内容。如果希望恢复数据库之后继续建立连接,则需要写这部分代码。我要恢复数据库名称为student1,备份数据库的时候是在连接状态下进行的,但是恢复数据库不可以在数据库存在连接的状态下进行操作!代码的解决方法是:先连接SQL Server中主库master 库,在该库中的sysprocesses表中存放着所有连接到此数据库的连接信息,将这些连接信息用Kill语句删除。然后再恢复数据库student1,由于用Kill语句后,数据库已经被断开,所以在恢复完成后,再用系统最初的连接数据库代码连接上数据库student1。
' 代码描述:SQL Server数据库的备份与恢复
'
' 注意事项:1.需要在工程中引用Microsoft SQLDMO Object Library
' 2.备份/恢复数据库时,要保证没有其它用户连接到SQL Server
'
' 窗体控件:2个Command,名称分别为cmdBackup,cmdRestore
' 1个Label,名称为lblProgress,用于显示备份/恢复进程。'------------------------------------------------------------------
'
Option ExplicitPrivate WithEvents objBackup As SQLDMO.Backup
Private WithEvents objRestore As SQLDMO.RestorePrivate Sub cmdBackup_Click()
Dim objSQLServer As New SQLDMO.SQLServer
Dim strServer As String
Dim strUserID As String
Dim strPassword As String
Dim strDatabase As String
Dim strFile As String
strServer = "Developer"
strUserID = "SA"
strPassword = ""
strDatabase = "Test"
strFile = "c:\test.bak"
If Dir(strFile) <> "" Then
If MsgBox("文件" & strFile & "已存在,是否删除?", vbQuestion + vbYesNo) = vbYes Then
Kill strFile
Else
Exit Sub
End If
End If
lblProgress.Caption = "备份进度: 0%"
Screen.MousePointer = 11
On Error GoTo ErrorHandler
objSQLServer.Connect strServer, strUserID, strPassword
Set objBackup = New SQLDMO.Backup
With objBackup
.PercentCompleteNotification = 1
.Database = strDatabase
.Files = strFile
.SQLBackup objSQLServer
End With
Set objBackup = Nothing
objSQLServer.Close
Set objSQLServer = Nothing
Screen.MousePointer = 0
Exit Sub
ErrorHandler:
Screen.MousePointer = 0
MsgBox Err.Description, vbCritical
End SubPrivate Sub cmdRestore_Click()
Dim objSQLServer As New SQLDMO.SQLServer
Dim strServer As String
Dim strUserID As String
Dim strPassword As String
Dim strDatabase As String
Dim strFile As String
strServer = "Developer"
strUserID = "SA"
strPassword = ""
strDatabase = "Test"
strFile = "c:\test.bak"
If Dir(strFile) = "" Then
MsgBox "文件" & strFile & "不存在!", vbExclamation
Exit Sub
End If
lblProgress.Caption = "恢复进度: 0%"
Screen.MousePointer = 11
On Error GoTo ErrorHandler
objSQLServer.Connect strServer, strUserID, strPassword
Set objRestore = New SQLDMO.Restore
With objRestore
.PercentCompleteNotification = 1
.Database = strDatabase
.ReplaceDatabase = True
.Files = strFile
.SQLRestore objSQLServer
End With
Set objRestore = Nothing
objSQLServer.Close
Set objSQLServer = Nothing
Screen.MousePointer = 0
Exit Sub
ErrorHandler:
Screen.MousePointer = 0
MsgBox Err.Description, vbCritical
End SubPrivate Sub objBackup_Complete(ByVal Message As String)
lblProgress.Caption = "备份成功!"
Set objBackup = Nothing
End SubPrivate Sub objBackup_PercentComplete(ByVal Message As String, ByVal Percent As Long)
lblProgress.Caption = "备份进度: " & Percent & "%"
DoEvents
End SubPrivate Sub objRestore_Complete(ByVal Message As String)
lblProgress.Caption = "恢复成功!"
Set objRestore = Nothing
End SubPrivate Sub objRestore_PercentComplete(ByVal Message As String, ByVal Percent As Long)
lblProgress.Caption = "恢复进度: " & Percent & "%"
DoEvents
End Sub
Sub backDataBase()
On Error GoTo errnum
dlg.CancelError = True
Cn1.Execute "use master"
dlg.Filter = "(*.bak)|*.bak"
dlg.ShowSave
MousePointer = 11
Cn1.Execute "BACKUP DATABASE kffgl TO DISK = '" & dlg.FileName & "'" '备份数据库
MousePointer = 0
Set Cn1 = Nothing
'重新建立连接
errnum:
Call dbint
Set Cn1 = New ADODB.Connection
Cn1.Open "Driver={SQL Server};Server=" & SQL_SRV & ";Uid=" & SA & ";Pwd=" & PA & ";Database=" & SJK & ""
End Sub
添加进度条ProgressBar1控件
引用Microsoft SQLDMO Object Library
'声明
Public WithEvents bkps As SQLDMO.Backup
'数据库备份操作
Private Sub Command3_Click()
Dim oSvr As SQLDMO.SQLServer
Set oSQLServer = CreateObject("SQLDMO.SQLServer")
oSQLServer.LoginSecure = False
oSQLServer.Connect ("(local)"), ("sa"), ("")'连接服务器
Screen.MousePointer = 11
Set bkps = CreateObject("SQLDMO.Backup")
bkps.Database = "db"'指定需备份的数据库
bkps.Action = 0
bkps.Files = "c:\backup\db.bak"'指定备份文件
bkps.Initialize = True
ProgressBar1.Value = 0
ProgressBar1.max = 100
Screen.MousePointer = 0
DoEvents
Err = 0
bkps.SQLBackup oSQLServer
Screen.MousePointer = 11
ProgressBar1.Value = 100
DoEvents
Set bkps = Nothing
Screen.MousePointer = 0
MsgBox "数据库备份完成"
End Sub
'显示进度
Private Sub bkps_PercentComplete(ByVal Message As String, ByVal Percent As Long)
ProgressBar1.Value = ProgressBar1.max * (Percent / 100)
End Sub
备份时ProgressBar1显示进度,恢复操作方法相同。
'*************************************************************************
'**模 块 名:fBackupDatabase_a
'**描 述:备份数据库,返回出错信息,正常恢复,返回""
'**调 用:fBackupDatabase_a "备份文件名","数据库名"
'**参数说明:
'** sBackUpfileName 恢复后的数据库存放目录
'** sDataBaseName 备份的数据名
'** sIsAddBackup 是否追加到备份文件中
'**说 明:引用Microsoft ActiveX Data Objects 2.x Library
'**创 建 人:邹建
'**日 期:2003年12月09日
'*************************************************************************
Public Function fBackupDatabase_a(ByVal sBackUpfileName$ _
, ByVal sDataBaseName$ _
, Optional ByVal sIsAddBackup As Boolean = False _
) As String
Dim iDb As ADODB.Connection
Dim iConcStr$, iSql$, iReturn$
On Error GoTo lbErr
'创建对象
Set iDb = New ADODB.Connection
'连接数据库服务器,根据你的情况修改连接字符串
iConcStr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Data Source=zj"
iDb.Open iConcStr
'生成数据库备份语句
iSql = "backup database [" & sDataBaseName & "]" & vbCrLf & _
"to disk='" & sBackUpfileName & "'" & vbCrLf & _
"with description='" & "zj-backup at:" & Date & "(" & Time & ")'" & vbCrLf & _
IIf(sIsAddBackup, "", ",init")
iDb.Execute iSql
GoTo lbExit
lbErr:
iReturn = Error
lbExit:
fBackupDatabase_a = iReturn
End Function'*************************************************************************
'**模 块 名:frestoredatabase_a
'**描 述:恢复数据库,返回出错信息,正常恢复,返回""
'**调 用:frestoredatabase_a "备份文件名","数据库名"
'**参数说明:
'** sDataBasePath 恢复后的数据库存放目录
'** sBackupNumber 是从那个备份号恢复
'** sReplaceExist 指定是否覆盖已经存在的数据
'**说 明:引用Microsoft ActiveX Data Objects 2.x Library
'**创 建 人:邹建
'**日 期:2003年12月09日
'*************************************************************************
Public Function fRestoreDatabase_a(ByVal sBackUpfileName$ _
, ByVal sDataBaseName$ _
, Optional ByVal sDataBasePath$ = "" _
, Optional ByVal sBackupNumber& = 1 _
, Optional ByVal sReplaceExist As Boolean = False _
) As String
Dim iDb As ADODB.Connection, iRe As ADODB.Recordset
Dim iConcStr$, iSql$, iReturn$, iI&
On Error GoTo lbErr
'创建对象
Set iDb = New ADODB.Connection
Set iRe = New ADODB.Recordset
'连接数据库服务器,根据你的情况修改连接字符串
iConcStr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Data Source=zj"
iDb.Open iConcStr
'得到还原后的数据库存放目录,如果没有指定,存放到SQL SERVER的DATA目录
If sDataBasePath = "" Then
iSql = "select filename from master..sysfiles"
iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
iSql = iRe(0)
iRe.Close
sDataBasePath = Left(iSql, InStrRev(iSql, "\"))
End If
'检查数据库是否存在
If sReplaceExist = False Then
iSql = "select 1 from master..sysdatabases where name='" & sDataBaseName & "'"
iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
If iRe.EOF = False Then
iReturn = "数据库已经存在!"
iRe.Close
GoTo lbExit
End If
iRe.Close
End If
'关闭用户进程,防止其它用户正在使用数据库,导致数据恢复失败
iSql = "select spid from master..sysprocesses where dbid=db_id('" & sDataBaseName & "')"
iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
While iRe.EOF = False
iSql = "kill " & iRe(0)
iDb.Execute iSql
iRe.MoveNext
Wend
iRe.Close
'获取数据库恢复信息
iSql = "restore filelistonly from disk='" & sBackUpfileName & "'" & vbCrLf & _
"with file=" & sBackupNumber
iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
'生成数据库恢复语句
iSql = "restore database [" & sDataBaseName & "]" & vbCrLf & _
"from disk='" & sBackUpfileName & "'" & vbCrLf & _
"with file=" & sBackupNumber & vbCrLf
With iRe
While Not .EOF
iReturn = iRe("PhysicalName")
iI = InStrRev(iReturn, ".")
iReturn = IIf(iI = 0, "", Mid(iReturn, iI)) & "'"
iSql = iSql & ",move '" & iRe("LogicalName") & _
"' to '" & sDataBasePath & sDataBaseName & iReturn & vbCrLf
.MoveNext
Wend
.Close
End With
iSql = iSql & IIf(sReplaceExist, ",replace", "")
iDb.Execute iSql
iReturn = ""
GoTo lbExit
lbErr:
iReturn = Error
lbExit:
fRestoreDatabase_a = iReturn
End Function
更多的参考我的贴子:数据库备份/恢复方案
http://expert.csdn.net/Expert/topic/2359/2359124.xml?temp=9.761989E-03