[RESOLVED] Recordset Counting problem

[intercepter]

Hi everyone. I have gotten great help here so I figured i would come back for this. The aspect of my present project is to do a keyword search through a access db and put that resulting record set into a collection, count the number of lines in the collection and reduce that number every time a segment of the resulted collection is viewed.

My code for creating the search result subset is this:

Private Sub KeyWordSearch()

Dim SQLStr, sString, UserName As String
Dim sPath As String
Dim Counter As Long
Dim tmpStr As String
Dim Count As Integer
Dim iHnd As Long
     iHnd = getPalSubForm(WindowClass, Combo1.Text, RoomOutboundTextBoxClass, SendTxtIndex)
     iHnd = SendTextHnd
Trigger = "$key"

On Error GoTo KeyWordError

cmdPos = InStr(1, RichTextBox2.Text, Trigger, vbBinaryCompare)
If cmdPos = 0 Then Exit Sub

cmdVer = Trim$(Right$(RichTextBox2.Text, (Len(RichTextBox2.Text) - cmdPos) - 4))

RichTextBox4.Text = Right(cmdVer, Len(cmdVer))

sString = RichTextBox4.Text

SQLStr = "Select tblBook.*,tblQUOTE.* From tblBook,tblQUOTE Where (tblQUOTE.Quote Like '%" & sString & "%') And tblBook.Book_ID=tblQUOTE.Book_ID Order by tblQUOTE.Book_ID,tblQUOTE.Chapter ASC"

Dim db1 As Connection
Set db1 = New Connection
db1.CursorLocation = adUseClient
sPath = App.Path & "\kjvbible.mdb"
db1.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & sPath
Set adoPrimaryRS1 = New Recordset
Set adoPrimaryRS1 = db1.Execute(SQLStr, , adCmdText)

Dim sr As New SearchResult
Dim a$

UserName = Text1.Text
colSearches.Add sr, UserName

While Not adoPrimaryRS1.EOF

tmpStr = adoPrimaryRS1!Book_Title & " " & adoPrimaryRS1!Chapter & ":" & adoPrimaryRS1!Verse
a$ = tmpStr
sr.Add a$
adoPrimaryRS1.MoveNext

RichTextBox1.Text = RichTextBox1.Text & tmpStr & " $$ "

Wend

Count = sr.LinesCount

If Count > 12 Then
Call SendMore((Text1.Text), 10)
RTB5 = Text1.Text & " Your Keyword or Phrase Search Results Are:  " & Count & "  Verse(s)  " & RichTextBox1.Text & " Type $more For More Results "
RTB5.SelLength = Len(RTB5.Text)

With RTB5
     .SelBold = True
     .SelFontSize = 8
     .SelColor = RGB(101, 0, 192)
End With

Call SendMessageByString(iHnd, WM_SETTEXT, 0&, RTB5)
Call SendMessage(iHnd, WM_KEYDOWN, 13, 0)

' Close RecordSet and Database
adoPrimaryRS1.Close
db1.Close

RTB5 = ""
Trigger = ""
RichTextBox1.Text = ""
RichTextBox2.Text = ""
RichTextBox4.Text = ""

Exit Sub
Else
End If


RTB5 = Text1.Text & " Your Keyword or Phrase Search Results Are:  " & Count & "  Verse(s)  " & RichTextBox1.Text
RTB5.SelLength = Len(RTB5.Text)

With RTB5
     .SelBold = True
     .SelFontSize = 8
     .SelColor = RGB(101, 0, 192)
End With

Call SendMessageByString(iHnd, WM_SETTEXT, 0&, RTB5)
Call SendMessage(iHnd, WM_KEYDOWN, 13, 0)


 Close Recordset And Database
adoPrimaryRS1.Close
db1.Close

RTB5 = ""
Trigger = ""
RichTextBox1.Text = ""
RichTextBox2.Text = ""
RichTextBox4.Text = ""

Exit Sub

KeyWordError:
RTB5 = Text1.Text & ": You Have A Search Pending and Cannot do Another Search.  Please Type $more for Additional Results or $stop to Clear Your Search"
RTB5.SelLength = Len(RTB5.Text)

With RTB5
     .SelBold = True
     .SelFontSize = 10
     .SelColor = RGB(101, 0, 192)
End With

Call SendMessageByString(iHnd, WM_SETTEXT, 0&, RTB5)
Call SendMessage(iHnd, WM_KEYDOWN, 13, 0)


' Close RecordSet and Database
adoPrimaryRS1.Close
db1.Close

RTB5 = ""
Trigger = ""
RichTextBox1.Text = ""
RichTextBox2.Text = ""
RichTextBox4.Text = ""

Exit Sub

End Sub

This code works just fine creating the search result. And giving me my initial count. The next set of commands are what are troubling me:

Private Sub SendMore(UserName As String, NumLines As Integer)
Dim r$, i%
Dim a$, sr As SearchResult
If UserName = "" Then Exit Sub
On Error GoTo NoResultsForThisUserName
Set sr = colSearches(UserName)

  For i = 1 To NumLines
      a$ = sr.NextLine
      r$ = r$ + a$ + " $$ "
  Next

RichTextBox1.Text = r$

NoResultsForThisUserName:
Exit Sub
End Sub

Private Sub MoreVer()
Dim iHnd As Long
     iHnd = getPalSubForm(WindowClass, Combo1.Text, RoomOutboundTextBoxClass, SendTxtIndex)
     iHnd = SendTextHnd


Dim u$
If colSearches.Count = 0 Then
RTB5 = Text1.Text & ": You Dont Have Any More Search Results To Display."
RTB5.SelLength = Len(RTB5.Text)

With RTB5
     .SelBold = True
     .SelFontSize = 10
     .SelColor = RGB(101, 0, 192)
End With

Call SendMessageByString(iHnd, WM_SETTEXT, 0&, RTB5)
Call SendMessage(iHnd, WM_KEYDOWN, 13, 0)

Exit Sub
Else
End If

  u$ = Text1.Text
  If u$ <> "" Then SendMore u$, 10

RTB5 = Text1.Text & " Your Keyword or Phrase Search Results Are:  " & Count & "  Verse(s)  " & RichTextBox1.Text & " Type $more for more results, "
RTB5.SelLength = Len(RTB5.Text)

With RTB5
     .SelBold = True
     .SelFontSize = 8
     .SelColor = RGB(101, 0, 192)
End With

Call SendMessageByString(iHnd, WM_SETTEXT, 0&, RTB5)
Call SendMessage(iHnd, WM_KEYDOWN, 13, 0)

RichTextBox1.Text = ""

End Sub

In an example, I do a earch and the count result is 72. The first time I execute the morever sub, it shows 63. Then 60 to the end of the pages of results I viewed.

I also have a class module:

Private Lines() As String
Public LinesCount As Integer
Public LinesLeft As Integer
Public LinesSent As Integer

Private colSearches As New Collection

Public Sub Add(NewLine As String)
  ReDim Preserve Lines(LinesCount)
  Lines(LinesCount) = NewLine
  LinesCount = LinesCount + 1
End Sub

Public Property Get NextLine() As String
  If LinesSent < LinesCount Then
     NextLine = Lines(LinesSent)
     LinesSent = LinesSent + 1
     LinesLeft = LinesCount - LinesSent
  Else
     NextLine = "End of Results. Please Type $stop to Clear Your Search" + vbCrLf
     LinesSent = LinesCount - 1
  End If
  
  
End Property

At the end when all records are displayed, i then get floods of more text I don't want, repeating In the else section of the Class module.


Any ideas or suggestions?