我想做一个查询系统,用下面一段代码,但是执行不成功,请高手指教,谢谢
Option Explicit
Private rsterm As ADODB.Recordset
Private rsmain As ADODB.Recordset
Private rsplm As ADODB.Recordset
Private Sub grdMainHH()
With grdmain
.Columns(0).Visible = False
.Columns(1).Width = 5000
.Columns(1).Caption = "答案"
.Columns(2).Visible = False
.Columns(2).Caption = "正确可能性"
.Columns(2).Width = 1200
End With
End Sub
Private Sub Command1_Click()
If txtid.Text = "" Then
MsgBox "请输入问题,问题不能为空。", vbExclamation, "提示"
txtid.SetFocus
Exit Sub
End If
If rsterm.RecordCount = 0 Then
MsgBox "数据库中无关键词,请先建立关键词数据库。", vbExclamation, "提示"
Exit Sub
End If
Dim a As Long
Dim lines As String
Dim key As String
'lines = Trim(txtid.Text)
Set rsplm = New ADODB.Recordset
'rsplm.Open "select * from main where id=Trim(txtid.Text)", Con, adOpenStatic, adLockOptimistic
'rsplm.Open "select id,object,probility from main where id=line", Con, adOpenStatic, adLockOptimistic
'rsplm.Open "select * from main where id=line", Con, adOpenStatic, adLockOptimistic
'rsplm.Open "select * from main where id='&lines&'", Con, adOpenStatic, adLockOptimistic
rsplm.Open "select * from main where id='&Trim(txtid.Text)&'", Con, adOpenStatic, adLockOptimisticIf rsplm.RecordCount <> 0 Then
Set grdmain.DataSource = rsplm
grdmain.Visible = True
grdmain.Columns(0).Visible = False
Call grdMainHH
Exit Sub
End If
rsplm.Close
rsterm.MoveFirst
Do While Not rsterm.EOF
'a = InStr(lines, Trim(rsterm.Fields("term")))
a = InStr(Trim(txtid.Text), Trim(rsterm.Fields("term")))
If a > 0 Then
' key = Trim(rsterm.Fields("term"))
Dim s As String
Dim c As String
Dim d As String
Dim Rs3 As ADODB.Recordset
Set Rs3 = New ADODB.Recordset
'Rs3.Open "select * from term where term=key", Con, adOpenStatic, adLockOptimistic
Rs3.Open "select * from term where term='&Trim(rsterm.Fields!term)&'", Con, adOpenStatic, adLockOptimistic
Do While Not Rs3.EOF
d = Rs3.Fields!probility
c = Trim(Rs3.Fields!id)
s = "update main set probility=probility + " & " " & Str(d) & " where id='" & Trim(c) & "'"
Con.Execute s
Rs3.Fields!Status = "Y"
Rs3.Update
Rs3.MoveNext
Loop
End If
rsterm.MoveNext
Loop
Set rsmain = New ADODB.Recordset
rsmain.Open "select * from main where probility>0 order by probility desc ", Con, adOpenStatic, adLockOptimistic
Set grdmain.DataSource = rsmain
grdmain.Visible = False
If rsmain.RecordCount > 0 Then grdmain.Visible = True
grdmain.Columns(0).Visible = False
Call grdMainHH
End Sub
Private Sub Form_Load() Con.Execute "update main set probility=0"
Con.Execute "update term set status='N'"
' Dim s As String
' s = "select * from main "
' Con.Execute
Set rsterm = New ADODB.Recordset
rsterm.Open "select distinct term from term where status='N' order by term asc ", Con, adOpenStatic, adLockOptimistic
End Sub
Private Sub Form_Unload(Cancel As Integer)
Me.Hide
txtid.Text = ""
frmmain.Show
End Sub
Option Explicit
Private rsterm As ADODB.Recordset
Private rsmain As ADODB.Recordset
Private rsplm As ADODB.Recordset
Private Sub grdMainHH()
With grdmain
.Columns(0).Visible = False
.Columns(1).Width = 5000
.Columns(1).Caption = "答案"
.Columns(2).Visible = False
.Columns(2).Caption = "正确可能性"
.Columns(2).Width = 1200
End With
End Sub
Private Sub Command1_Click()
If txtid.Text = "" Then
MsgBox "请输入问题,问题不能为空。", vbExclamation, "提示"
txtid.SetFocus
Exit Sub
End If
If rsterm.RecordCount = 0 Then
MsgBox "数据库中无关键词,请先建立关键词数据库。", vbExclamation, "提示"
Exit Sub
End If
Dim a As Long
Dim lines As String
Dim key As String
'lines = Trim(txtid.Text)
Set rsplm = New ADODB.Recordset
'rsplm.Open "select * from main where id=Trim(txtid.Text)", Con, adOpenStatic, adLockOptimistic
'rsplm.Open "select id,object,probility from main where id=line", Con, adOpenStatic, adLockOptimistic
'rsplm.Open "select * from main where id=line", Con, adOpenStatic, adLockOptimistic
'rsplm.Open "select * from main where id='&lines&'", Con, adOpenStatic, adLockOptimistic
rsplm.Open "select * from main where id='&Trim(txtid.Text)&'", Con, adOpenStatic, adLockOptimisticIf rsplm.RecordCount <> 0 Then
Set grdmain.DataSource = rsplm
grdmain.Visible = True
grdmain.Columns(0).Visible = False
Call grdMainHH
Exit Sub
End If
rsplm.Close
rsterm.MoveFirst
Do While Not rsterm.EOF
'a = InStr(lines, Trim(rsterm.Fields("term")))
a = InStr(Trim(txtid.Text), Trim(rsterm.Fields("term")))
If a > 0 Then
' key = Trim(rsterm.Fields("term"))
Dim s As String
Dim c As String
Dim d As String
Dim Rs3 As ADODB.Recordset
Set Rs3 = New ADODB.Recordset
'Rs3.Open "select * from term where term=key", Con, adOpenStatic, adLockOptimistic
Rs3.Open "select * from term where term='&Trim(rsterm.Fields!term)&'", Con, adOpenStatic, adLockOptimistic
Do While Not Rs3.EOF
d = Rs3.Fields!probility
c = Trim(Rs3.Fields!id)
s = "update main set probility=probility + " & " " & Str(d) & " where id='" & Trim(c) & "'"
Con.Execute s
Rs3.Fields!Status = "Y"
Rs3.Update
Rs3.MoveNext
Loop
End If
rsterm.MoveNext
Loop
Set rsmain = New ADODB.Recordset
rsmain.Open "select * from main where probility>0 order by probility desc ", Con, adOpenStatic, adLockOptimistic
Set grdmain.DataSource = rsmain
grdmain.Visible = False
If rsmain.RecordCount > 0 Then grdmain.Visible = True
grdmain.Columns(0).Visible = False
Call grdMainHH
End Sub
Private Sub Form_Load() Con.Execute "update main set probility=0"
Con.Execute "update term set status='N'"
' Dim s As String
' s = "select * from main "
' Con.Execute
Set rsterm = New ADODB.Recordset
rsterm.Open "select distinct term from term where status='N' order by term asc ", Con, adOpenStatic, adLockOptimistic
End Sub
Private Sub Form_Unload(Cancel As Integer)
Me.Hide
txtid.Text = ""
frmmain.Show
End Sub
If rsterm.RecordCount = 0 Then
MsgBox "数据库中无关键词,请先建立关键词数据库。", vbExclamation, "提示"
Exit Sub
End If
且如下的语句中的exit sub应删除。
If rsplm.RecordCount <> 0 Then
Set grdmain.DataSource = rsplm
grdmain.Visible = True
grdmain.Columns(0).Visible = False
Call grdMainHH
Exit Sub
End If反正你上面的Command1_click中的语句,一大堆,意思不明确!用“逐句调试”看看程序执行到什么地方就退出。!