VB连接数据库

VB连接数据库 Dim stNo As Integer Dim A(2) As Variant Dim b(2) As Variant Dim c(2) As Variant Dim d(2) As Variant Dim u As Integer Dim i As Integer Dim o As Integer Dim p As Integer Dim myDE As New destudent Private Function Num(ID As String) As String Dim ii As Integer Dim iNum(9) As Integer Dim sChar As String For ii = 1 To Len(ID) sChar = Mid(ID, ii, 1) iNum(Asc(sChar) - 48) = iNum(Asc(sChar) - 48) + 1 Next For ii = 0 To 9 Num = Num & ii & ":" & iNum(ii) & " " Next End Function Private Sub Check1_Click() If Check1.Value = vbChecked Then Combo4.Enabled = True Combo5.Enabled = True Combo6.Enabled = True Else If Check1.Value = vbUnchecked Then Combo4.Enabled = False Combo5.Enabled = False Combo6.Enabled = False End If End If End Sub Private Sub Combo1_Change() frmStInfo.Tag = 1 End Sub Private Sub Combo2_Change() frmStInfo.Tag = 1 End Sub Private Sub Combo3_Change() frmStInfo.Tag = 1 End Sub Private Sub Combo4_Change() frmStInfo.Tag = 1 End Sub Private Sub Combo5_Change() frmStInfo.Tag = 1 End Sub Private Sub Combo6_Change() frmStInfo.Tag = 1 End Sub Private Sub Combo7_Change() frmStInfo.Tag = 1 End Sub Private Sub Command1_Click() Text1.Text = "" Text2.Text = "" Combo1.Text = "" Text3.Text = "" Text6.Text = "" Text7.Text = "" End Sub Private Sub Command2_Click_OLD() ''学生信息保存到数组 Dim ii As Integer If Text1.Text = "" Or Text2.Text = "" Or Text6.Text = "" Or 学院.Text = "" Then MsgBox "你填写的信息有遗漏，请重新填写" End If If Text1.Text <> "" And Text2.Text <> "" And Text6.Text <> "" And 学院.Text <> "" Then MsgBox "你已经成功的进行保存" frmStInfo.Tag = 2 End If '存储姓名 stInfo(stNo, 0) = Text2.Text '存储性别 If Option1.Value = True Then stInfo(stNo, 1) = Option1.Caption Else: If Option2.Value = _ True Then stInfo(stNo, 1) = Option2.Caption End If '存储民族 stInfo(stNo, 2) = Combo1.Text '存储籍贯 stInfo(stNo, 3) = Text3.Text '存储学院 stInfo(stNo, 4) = 学院.Text '存储专业 stInfo(stNo, 5) = 专业.Text '存储身份证号 stInfo(stNo, 6) = Text6.Text For ii = 0 To 6 Debug.Print stInfo(stNo, ii) Next stNo = stNo + 1 If stNo > 9 Then stNo = 0 End Sub Private Sub Command2_Click() ''将学生信息保存到数据库 ' myDE.rscmdQuery.open "Tbl_Dep", , adOpenDynamic, adLockOptimistic End Sub Private Sub Command4_Click() frmStScore.Show frmStInfo.Hide End Sub Private Sub Command5_Click() frmOntest.Show frmStInfo.Hide End Sub Private Sub Command6_Click() Unload frmStInfo End Sub Private Sub Form_Load_OLD() ''用数组初始化 A(0) = "经济管理学院" A(1) = "人文学院" A(2) = "理学院" For u = 0 To 2 学院.AddItem A(u) Next frmStInfo.Tag = 0 '用数组添加年 Dim n(19) As Integer Dim m As Integer For m = 0 To 19 n(m) = m + 1989 Combo2.AddItem n(m) Combo4.AddItem n(m) Next '用数组添加月份 Dim j(11) As Integer Dim i As Integer For i = 0 To 11 j(i) = i + 1 Combo3.AddItem j(i) Combo5.AddItem j(i) Next '用数组添加日 Dim q(30) As Integer Dim w As Integer For w = 0 To 30 q(w) = w + 1 Combo7.AddItem q(w) Combo6.AddItem q(w) Next End Sub Private Sub Form_Load() ''用数据库初始化 Dim strSQL As String strSQL = "SELECT Distinct Tbl_Dep.s_department FROM Tbl_Dep" myDE.rscmdQuery.open strSQL, , adOpenDynamic, adLockOptimistic Do While Not myDE.rscmdQuery.EOF 学院.AddItem myDE.rscmdQuery.Fields("s_department") myDE.rscmdQuery.MoveNext Loop myDE.rscmdQuery.close 学院.Text = 学院.List(0) Me.Tag = 0 End Sub Private Sub Form_Unload(Cancel As Integer) If frmStInfo.Tag = 0 Then Unload frmStInfo ElseIf frmStInfo.Tag = 1 Then i = MsgBox("当前 记录 混凝土 养护记录下载土方回填监理旁站记录免费下载集备记录下载集备记录下载集备记录下载 尚未被保存，确认是否要退出", vbYesNo, "警告") If i = vbYes Then Unload frmStInfo Else Cancel = True End If ElseIf frmStInfo.Tag = 2 Then MsgBox "你的信息已经成功保存，可以安全退出" Unload frmStInfo End If End Sub Private Sub Option1_Click() frmStInfo.Tag = 1 End Sub Private Sub Option2_Click() frmStInfo.Tag = 1 End Sub Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then PopupMenu menu End Sub Private Sub Text1_Change() frmStInfo.Tag = 1 End Sub Private Sub Text2_Change() frmStInfo.Tag = 1 End Sub Private Sub Text3_Change() frmStInfo.Tag = 1 End Sub Private Sub Text6_Change() frmStInfo.Tag = 1 End Sub Private Sub Text6_KeyPress(KeyAscii As Integer) If KeyAscii >= Asc("0") And KeyAscii <= Asc("9") _ Or KeyAscii = 8 Then Else KeyAscii = 0 MsgBox "您填写的身份证号必须是数字" End If End Sub Private Sub Text6_LostFocus() If Len(Text6.Text) <> 18 Then MsgBox "身份证号不正确，请重新填写" Text6.SetFocus End If Text7.Text = Num(Text6.Text) End Sub Private Sub Text7_Change() frmStInfo.Tag = 1 End Sub Private Sub 学院_Change() frmStInfo.Tag = 1 End Sub Private Sub 学院_Click() ''用数据库初始化 Dim strSQL As String 专业.Clear 'strSQL = "SELECT DISTINCT Tbl_Dep.s_department, Tbl_Dep.s_specialty From Tbl_Dep WHERE (((Tbl_Dep.s_department)='经管'))" strSQL = "SELECT DISTINCT Tbl_Dep.s_department, Tbl_Dep.s_specialty" _ & " From Tbl_Dep" _ & " WHERE (((Tbl_Dep.s_department)='" & 学院.Text & "'))" myDE.rscmdQuery.open strSQL, , adOpenDynamic, adLockOptimistic Do While Not myDE.rscmdQuery.EOF 专业.AddItem myDE.rscmdQuery.Fields("s_specialty") myDE.rscmdQuery.MoveNext Loop myDE.rscmdQuery.close 专业.Text = 专业.List(0) End Sub strSQL1 = "SELECT DISTINCT Tbl_Dep.s_department, Tbl_Dep.s_specialty" _ & " From Tbl_Dep" _ & " WHERE (((Tbl_Dep.s_department)='" & 学院.Text & "'))" Do While Not myDE.rscmdSQL.EOF Combo9.AddItem myDE.rscmdSQL.Fields("s_specialty") myDE.rscmdSQL.MoveNext Loop Private Sub 专业_Change() frmStInfo.Tag = 1 End Sub Private Sub 学院_Click_OLD() ''用数组的形式初始化 专业.Clear If 学院.Text = A(0) Then b(0) = "物流管理" b(1) = "信息管理" b(2) = "工商管理" For i = 0 To 2 专业.AddItem b(i) Next End If If 学院.Text = A(1) Then c(0) = "法律" c(1) = "英语" c(2) = "哲学" For o = 0 To 2 专业.AddItem c(o) Next End If If 学院.Text = A(2) Then d(0) = "数学" d(1) = "物理" d(2) = "化学" For p = 0 To 2 专业.AddItem d(p) Next End If End Sub