我想做一个查询系统,用下面一段代码,但是执行不成功,请高手指教,谢谢
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

解决方案 »

  1.   

    把那一句rsplm.Close删掉(应放在Form_Load中)
      

  2.   

    还有如下语句应删去:
    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中的语句,一大堆,意思不明确!用“逐句调试”看看程序执行到什么地方就退出。!