为什么数据库老是连接不上？在线求解答！！！谢谢啦1
我的数据库就是连接不上去···错误91 请大家帮忙看看···代码：
Option Explicit '在文件级强制对该文件中的所有变量进行显式声明。
Dim rs As ADODB.Recordset
Dim SQL As String
Dim msg As String
Dim Index As Integer
Public flag As String '判断是新增记录还是修改记录
Dim YGID As String '保存员工ID
Private Sub Form_Load()
'初始化性别条件CmoboBox
CboSex.AddItem ("男")
CboSex.AddItem ("女")
CboSex.ListIndex = 0 '默认性别为男
'初始化所属部门ID CmoboBox
SQL = "select * from DI order by DID"
Call SelectSQL(SQL, msg)
Set rs = SelectSQL(SQL, msg)
If rs.RecordCount = 0 Then '如果没有部门信息
MsgBox ("请先建立部门类型！")
Exit Sub
Else
Do While Not rs.BOF And Not rs.EOF
'添加到ComboBox列表
Me.CboBMID.AddItem (rs.Fields("DID") & rs.Fields("DName"))
rs.MoveNext '指向下一条记录
Loop
Me.CboBMID.ListIndex = 0 '默认ComboBox
'截取部门信息的前3位作为员工ID
Me.txtYGID.Text = Left(Trim(CboBMID.Text), 3)
rs.Close
End If
'初始化职务代码ComboBox
SQL = "select * from PI order by PID"
Call SelectSQL(SQL, msg)
Set rs = SelectSQL(SQL, msg)
If rs.RecordCount = 0 Then '如果没有职务信息
MsgBox ("请先建立职务信息类型！")
Exit Sub
Else
Do While Not rs.BOF And Not rs.EOF
'添加到ComboBox列表
Me.CboZWID.AddItem (rs.Fields("PID") & rs.Fields("PName"))
rs.MoveNext '指向下一条记录
Loop
Me.CboZWID.ListIndex = 0 '默认ComboBox
rs.Close
End If
'初始化在岗状态ComboBox
CboZhZ.AddItem ("在职")
CboZhZ.AddItem ("离职退休")
CboZhZ.AddItem ("返聘")
CboZhZ.AddItem ("在职培训")
CboZhZ.ListIndex = 0 '默认在岗状态为在职
'判断是添加还是修改
If flag = "Add" Then
Me.Caption = "员工基本信息添加"
FramePerson.Caption = "员工基本信息添加"
SQL = "select * from SI"
Call SelectSQL(SQL, msg)
Set rs = SelectSQL(SQL, msg)
'设置控件可用性
CmdAdd.Visible = True
CmdSave.Enabled = False
CmdCancel.Enabled = False
FramePerson.Enabled = False
Else
Me.Caption = "员工基本信息修改"
FramePerson.Caption = "员工基本信息修改"
'设置控件可用性
CmdAdd.Visible = False
txtYGID.Enabled = False
txtName.Enabled = False
CboBMID.Enabled = False
Call showdata '显示数据
End If
End Sub
Private Sub showdata()
'在控件中显示数据
YGID = B员工基本信息.YGID '得到所有修改的员工ID
SQL = "select * from SI where SID='" & Trim(YGID) & "'"
Call SelectSQL(SQL, msg)
Set rs = SelectSQL(SQL, msg)
If rs.RecordCount = 1 Then '如果存在这条记录
'为控件赋值
Me.txtYGID = rs.Fields(0)
Me.txtName = rs.Fields(3)
Me.CboSex.Text = rs.Fields(4)
Me.DTPicker1.Value = rs.Fields(5)
Me.txtJG = rs.Fields(6)
Me.txtMZhu = rs.Fields(7)
Me.txtID = rs.Fields(8)
Me.txtZhZMM = rs.Fields(9)
'保证记录中的所属部门ID与ComboBox中的值相一致
For Index = 0 To Me.CboBMID.ListCount - 1
If (Left(CboBMID.List(Index), 3) = rs.Fields("DID")) Then
CboBMID.ListIndex = Index
Exit For
End If
Next Index
Me.DTPicker2.Value = rs.Fields("SEDate")
'保证记录中的职务代码与ComboBox中的值相一致
For Index = 0 To Me.CboZWID.ListCount - 1
If (Left(CboZWID.List(Index), 3) = rs.Fields("PID")) Then
CboZWID.ListIndex = Index
Exit For
End If
Next Index
Me.txtZCh = rs.Fields(11)
Me.DTPicker3.Value = rs.Fields(12)
Me.txtYDW = rs.Fields(13)
Me.txtYZC = rs.Fields(14)
Me.txtYZW = rs.Fields(15)
Me.txtXX = rs.Fields(16)
Me.DTPicker4.Value = rs.Fields(17)
Me.txtXL = rs.Fields(18)
Me.txtZY = rs.Fields(19)
Me.txtYY = rs.Fields(20)
Me.txtAdd = rs.Fields(21)
Me.txtPhone = rs.Fields(22)
Me.txtMail = rs.Fields(23)
'为在岗状态赋值
For Index = 0 To Me.CboZhZ.ListCount - 1
If CboZhZ.List(Index) = rs.Fields("SState") Then
CboZhZ.ListIndex = Index
Exit For
End If
Next Index
Else
MsgBox ("员工信息检索出错！")
End If
End Sub
Private Sub CmdAdd_Click()
'重置控件
CboBMID.ListIndex = 0
Me.txtYGID.Text = Left(Trim(CboBMID.Text), 3)
Me.txtName = ""
Me.CboSex.ListIndex = 0
Me.DTPicker1.Refresh
Me.txtJG = ""
Me.txtMZhu = ""
Me.txtID = ""
Me.txtZCh = ""
Me.DTPicker2.Refresh
Me.CboZWID.ListIndex = 0
Me.txtZhZMM = ""
Me.DTPicker3.Refresh
Me.txtYDW = ""
Me.txtYZC = ""
Me.txtYZW = ""
Me.txtXX = ""
Me.DTPicker4.Refresh
Me.txtXL = ""
Me.txtZY = ""
Me.txtYY = ""
Me.txtAdd = ""
Me.txtPhone = ""
Me.txtMail = ""
Me.CboZhZ.ListIndex = 0
CmdAdd.Enabled = False
CmdSave.Enabled = True
CmdCancel.Enabled = True
FramePerson.Enabled = True
End Sub
Private Sub CmdSave_click()
'保存操作
On Error GoTo ErrMsg '出错处理
If Not CheckData Then Exit Sub '如果数据不合法就退出
If flag = "Modify" Then '如果是修改数据
msg = MsgBox("您确实要修改这条数据吗？", vbYesNo)
If msg = vbYes Then '如果单击【是】按钮
Call setdata '设置数据
Else
Exit Sub
End If
ElseIf flag = "Add" Then '如果添加新数据
rs.AddNew
Call setdata '设置数据
End If
rs.Update
If flag = "Add" Then '如果标志为“Add”
MsgBox ("成功添加数据！")
CmdAdd.Enabled = True
CmdSave.Enabled = False
CmdCancel.Enabled = False
Else
MsgBox ("成功更新数据！")
End If
Call B员工基本信息.reload
Exit Sub
ErrMsg: '报告出错信息
MsgBox Err.Description, vbExclamation, "出错"
End Sub
Private Function CheckData() As Boolean
'检查数据的合法性
Dim rst As ADODB.Recordset
Dim msgt As String
msgt = ""
'检查数据
If Trim(Me.txtYGID.Text) = "" Then '检查员工ID是否为空
msgt = "员工ID为空；"
ElseIf Not Len(Trim(txtYGID.Text)) = 8 Then '检查员工ID是否为8位
msgt = msgt & "员工ID不是8位"
ElseIf Trim(Me.txtName.Text) = "" Then '检查姓名是否为空
msgt = msgt & "姓名为空；"
ElseIf Trim(txtID.Text) = "" Then '检查身份证号是否为空
msgt = msgt & "身份证号为空；"
ElseIf Not Len(Trim(txtID.Text)) = 18 Then '检查身份证号是否为18位
msgt = msgt & "身份证号不是18位"
ElseIf Trim(Me.CboBMID.Text) = "" Then '检查所属部门ID是否为空
msgt = msgt & "所属部门ID为空；"
ElseIf Trim(ComZWIDID.Text) = "" Then '检查职务代码是否为空
msgt = msgt & "职务代码为空；"
End If
'检查员工ID是否合法
If CboBMID.ListCount > 0 Then
'如果员工ID的前4位和部门ID不相等
If Left(Trim(Me.txtYGID.Text), 4) <> Left(Trim(CboBMID.Text), 4) Then
msgt = msgt & "员工ID不合法，前四位为部门号；"
End If
End If
If Not msgt = "" Then '如果错误信息不为空，则给出错误提示
MsgBox (msgt)
CheckData = False '返回False
Exit Function
End If
'检查唯一性
SQL = "select * from SI where SIID='" & Trim(txtYGID.Text) & "'"
Set rst = SelectSQL(SQL, msg)
'如果是进行添加操作且已经存在该记录，则提示重复添加
If flag = "add" And rst.RecordCount > 0 Then
MsgBox ("该员工信息已经存在，重复添加！")
rst.Close
CheckData = False '返回False
Exit Function
End If
CheckData = True '合法则返回true
rs.Close
End Function
Private Sub SetDate()
'为字段设置数据
rs.Fields(0) = Me.txtYGID.Text
rs.Fields(1) = Left(Trim(Me.CboBMID.Text), 3)
rs.Fields(2) = Left(Trim(Me.CboZWID.Text), 3)
rs.Fields(3) = Me.txtName.Text
rs.Fields(4) = Trim(Me.CboSex.Text)
rs.Fields(5) = Me.DTPicker1.Value
rs.Fields(6) = Me.txtJG.Text
rs.Fields(7) = Me.txtMZhu.Text
rs.Fields(8) = Me.txtID.Text
rs.Fields(9) = Me.txtZhZMM.Text
rs.Fields(10) = Me.DTPicker2.Value
rs.Fields(11) = Me.txtZCh.Text
rs.Fields(12) = Me.DTPicker3.Value
rs.Fields(13) = Me.txtYDW.Text
rs.Fields(14) = Me.txtYZC.Text
rs.Fields(15) = Me.txtYZW.Text
rs.Fields(16) = Me.txtXX.Text
rs.Fields(17) = Me.DTPicker4.Value
rs.Fields(18) = Me.txtXL.Text
rs.Fields(19) = Me.txtZY.Text
rs.Fields(20) = Me.txtYY.Text
rs.Fields(21) = Me.txtAdd.Text
rs.Fields(22) = Me.txtPhone.Text
rs.Fields(23) = Me.txtMail.Text
rs.Fields(24) = Trim(Me.CboZhZ.Text)
End Sub
--------------------编程问答-------------------- 这些东西与你的数据库连不上有什么关系吗?
你该用数据库客户端测试下连接代码是否正确. --------------------编程问答-------------------- 好长的代码啊，有用的不多 --------------------编程问答-------------------- 连接字符串呢？ --------------------编程问答-------------------- 发这么多代码 没用啊
参考
补充：.NET技术 , ASP.NET
