大家帮我看看VB数据库备份代码哪里出错老是显示无效的SQL语句 15
PublicFunctionfBackupDatabase_a(ByValsBackUpfileName$_,ByValsDataBaseName$_,OptionalB...
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$, DataPath$
DataPath = App.Path + "/data/Data_cggl.mdb"
On Error GoTo lbErr
'创建对象
Set iDb = New ADODB.Connection
'连接数据库服务器,根据你的情况修改连接字符串
iConcStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + DataPath + ";Persist Security Info=False" + ";Jet OLEDB:Database Password="
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
'定义字符串变量
Private Sub Command1_Click()
Command1.Enabled = False
If Text1.Text = "" Then
MsgBox "请您选择数据库备份的路径!", 64, "羽绒管理系统"
Else
Dim connter As Integer
Dim SQL, workarea(15) As String
ProgressBar1.Visible = True
ProgressBar1.Max = UBound(workarea)
ProgressBar1.Value = ProgressBar1.Min
For connter = LBound(workarea) To UBound(workarea)
workarea(connter) = "initial value" & connter
ProgressBar1.Value = connter
DataPath = App.Path + "/data/Data_cggl.mdb"
sBackUpfileName = Text1.Text
sDataBaseName = DataPath
ErrMeg = fBackupDatabase_a(sBackUpfileName, sDataBaseName)
Next connter
If ErrMeg <> "" Then
MsgBox "错误:" & ErrMeg
ProgressBar1.Value = ProgressBar1.Min
MsgBox "数据库备份成功!"
Command1.Enabled = True
End If
frm_main.StatusBar1.Panels.Item(3).Text = frm_sjbf.Text4.Text
frm_main.Check1.Value = Check1.Value
frm_main.Check2.Value = Check2.Value
frm_main.Check3.Value = Check3.Value
frm_main.Check4.Value = Check4.Value
frm_main.Check5.Value = Check5.Value
frm_main.Check6.Value = Check6.Value
End If
End Sub 展开
, ByVal sDataBaseName$ _
, Optional ByVal sIsAddBackup As Boolean = False _
) As String
Dim iDb As ADODB.Connection
Dim iConcStr$, iSql$, iReturn$, DataPath$
DataPath = App.Path + "/data/Data_cggl.mdb"
On Error GoTo lbErr
'创建对象
Set iDb = New ADODB.Connection
'连接数据库服务器,根据你的情况修改连接字符串
iConcStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + DataPath + ";Persist Security Info=False" + ";Jet OLEDB:Database Password="
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
'定义字符串变量
Private Sub Command1_Click()
Command1.Enabled = False
If Text1.Text = "" Then
MsgBox "请您选择数据库备份的路径!", 64, "羽绒管理系统"
Else
Dim connter As Integer
Dim SQL, workarea(15) As String
ProgressBar1.Visible = True
ProgressBar1.Max = UBound(workarea)
ProgressBar1.Value = ProgressBar1.Min
For connter = LBound(workarea) To UBound(workarea)
workarea(connter) = "initial value" & connter
ProgressBar1.Value = connter
DataPath = App.Path + "/data/Data_cggl.mdb"
sBackUpfileName = Text1.Text
sDataBaseName = DataPath
ErrMeg = fBackupDatabase_a(sBackUpfileName, sDataBaseName)
Next connter
If ErrMeg <> "" Then
MsgBox "错误:" & ErrMeg
ProgressBar1.Value = ProgressBar1.Min
MsgBox "数据库备份成功!"
Command1.Enabled = True
End If
frm_main.StatusBar1.Panels.Item(3).Text = frm_sjbf.Text4.Text
frm_main.Check1.Value = Check1.Value
frm_main.Check2.Value = Check2.Value
frm_main.Check3.Value = Check3.Value
frm_main.Check4.Value = Check4.Value
frm_main.Check5.Value = Check5.Value
frm_main.Check6.Value = Check6.Value
End If
End Sub 展开
1个回答
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询