UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Universal Search Help, Access 2013    
 
   
tlsn4
post Apr 10 2018, 02:44 PM
Post#1



Posts: 250
Joined: 12-August 03
From: Olympia, WA


Hey UA!

So I'm using Candice Tripp's universal search tool here. It works great for my need, but it keeps returning "~TMP" tables. I'm able to ignore them, so it's isn't horrible. Just was wondering if anyone could provide a solution to adjust the code to remove the temporary tables so I don't have to keep ignoring them. This is the code behind the search button:

CODE
Private Sub cmdSearch_Click()
On Error Resume Next

    Dim strSearch As String
    Dim tdf As DAO.TableDef
    Dim rs As DAO.Recordset
    Dim RSS As DAO.Recordset
    Dim lngLoc As Long
    Dim lngRow As Long
    Dim lngI As Long
    Dim strQuote As String
    
    If IsNull(Me.txtSearch) Or Trim(Me.txtSearch) = "" Then Exit Sub
        
    strSearch = Me.txtSearch
    
    Me.lblMessage.Caption = "Searching for '" & strSearch & "'."
    
    Set rs = CurrentDb.OpenRecordset("tblSearchMatch")
    
    For Each tdf In CurrentDb.TableDefs
        If Left(tdf.name, 4) <> "MSys" And tdf.name <> "tblSearchMatch" Then
            Set RSS = CurrentDb.OpenRecordset(tdf.name)
            If Not RSS.BOF Then
                lngRow = 1
                Do Until RSS.EOF
                
                    For lngI = 0 To RSS.Fields.Count - 1
                        
                        lngLoc = InStr(1, RSS.Fields(lngI).Value, strSearch)
                        If lngLoc <> 0 Then
                            ' build list
                            rs.AddNew
                            rs("TableName") = tdf.name
                            rs("FieldName") = RSS.Fields(lngI).name
                            rs("RecordPosition") = lngRow
                                                
                            strQuote = RSS.Fields(lngI).Value
                            If lngLoc <= 20 Then
                                strQuote = Left(strQuote, Len(strSearch) + 40) & "..."
                            ElseIf lngLoc >= Len(strQuote) - 20 Then
                                strQuote = "..." & Right(strQuote, Len(strSearch) + 40)
                            Else
                                strQuote = "..." & Mid(strQuote, lngLoc - 5, Len(strSearch) + 40) & "..."
                            End If
                                                
                            rs("SearchQuote") = strQuote
                            rs.Update
                        End If
                        lngLoc = 0
                        
                    Next lngI
                    
                    lngRow = lngRow + 1
                    RSS.MoveNext
                Loop
            End If
            RSS.Close
        End If
    Next tdf
    
    rs.Close
    Set rs = Nothing
    
    Me.lstResults.Requery
    
    Dim lngCount As Long
    lngCount = DLookup("MatchCount", "qselSearchMatchCount")
        
    Me.lblMessage.Caption = "Search completed." & vbCrLf & lngCount & " matches found."
    
            
End Sub


Any help would be greatly appreciated.

Thanks
Taz
Go to the top of the page
 
Doug Steele
post Apr 10 2018, 03:03 PM
Post#2


UtterAccess VIP
Posts: 22,203
Joined: 8-January 07
From: St. Catharines, ON (Canada)


Fast would be to change

CODE
        If Left(tdf.name, 4) <> "MSys" And tdf.name <> "tblSearchMatch" Then

to

CODE
        If Left(tdf.name, 4) <> "MSys" And Left(tdf.name, 4) <> "~tmp" And tdf.name <> "tblSearchMatch" Then
Go to the top of the page
 
ADezii
post Apr 10 2018, 03:13 PM
Post#3



Posts: 2,674
Joined: 4-February 07
From: USA, Florida, Delray Beach


You could try adding another If...End If Construct to the overall Logic, as in:
CODE
'****************************** CODE INTENTIONALLY OMITTED ******************************
For Each tdf In CurrentDb.TableDefs
  If Left(tdf.Name, 4) <> "MSys" And tdf.Name <> "tblSearchMatch" Then
    If UCase$(Left$(tdf.Name, 4)) <> "~TMP" Then    'If Construct added here
      Set RSS = CurrentDb.OpenRecordset(tdf.Name)
        If Not RSS.BOF Then
          lngRow = 1
          Do Until RSS.EOF
            For lngI = 0 To RSS.Fields.Count - 1
              lngLoc = InStr(1, RSS.Fields(lngI).Value, strSearch)
                If lngLoc <> 0 Then
                  ' build list
                  rs.AddNew
                  rs("TableName") = tdf.Name
                  rs("FieldName") = RSS.Fields(lngI).Name
                  rs("RecordPosition") = lngRow
                                                
                  strQuote = RSS.Fields(lngI).Value
                  If lngLoc <= 20 Then
                    strQuote = Left(strQuote, Len(strSearch) + 40) & "..."
                  ElseIf lngLoc >= Len(strQuote) - 20 Then
                    strQuote = "..." & Right(strQuote, Len(strSearch) + 40)
                  Else
                    strQuote = "..." & Mid(strQuote, lngLoc - 5, Len(strSearch) + 40) & _
                               "..."
                  End If
                  rs("SearchQuote") = strQuote
                  rs.Update
                End If
                lngLoc = 0
            Next lngI
              lngRow = lngRow + 1
              RSS.MoveNext
          Loop
        End If
    End If
    RSS.Close
  End If
Next td
'****************************** CODE INTENTIONALLY OMITTED ******************************

Go to the top of the page
 
ADezii
post Apr 10 2018, 03:13 PM
Post#4



Posts: 2,674
Joined: 4-February 07
From: USA, Florida, Delray Beach


You could try adding another If...End If Construct to the overall Logic ('If Construct added here), as in:
CODE
'****************************** CODE INTENTIONALLY OMITTED ******************************
For Each tdf In CurrentDb.TableDefs
  If Left(tdf.Name, 4) <> "MSys" And tdf.Name <> "tblSearchMatch" Then
    If UCase$(Left$(tdf.Name, 4)) <> "~TMP" Then    'If Construct added here
      Set RSS = CurrentDb.OpenRecordset(tdf.Name)
        If Not RSS.BOF Then
          lngRow = 1
          Do Until RSS.EOF
            For lngI = 0 To RSS.Fields.Count - 1
              lngLoc = InStr(1, RSS.Fields(lngI).Value, strSearch)
                If lngLoc <> 0 Then
                  ' build list
                  rs.AddNew
                    rs("TableName") = tdf.Name
                    rs("FieldName") = RSS.Fields(lngI).Name
                    rs("RecordPosition") = lngRow
                                                
                    strQuote = RSS.Fields(lngI).Value
                    If lngLoc <= 20 Then
                      strQuote = Left(strQuote, Len(strSearch) + 40) & "..."
                    ElseIf lngLoc >= Len(strQuote) - 20 Then
                      strQuote = "..." & Right(strQuote, Len(strSearch) + 40)
                    Else
                      strQuote = "..." & Mid(strQuote, lngLoc - 5, Len(strSearch) + 40) & _
                                 "..."
                    End If
                    rs("SearchQuote") = strQuote
                  rs.Update
                End If
                lngLoc = 0
            Next lngI
              lngRow = lngRow + 1
              RSS.MoveNext
          Loop
        End If          'End of added If...End If Construct
    End If
    RSS.Close
  End If
Next td
'****************************** CODE INTENTIONALLY OMITTED ******************************

This post has been edited by ADezii: Apr 10 2018, 03:20 PM
Go to the top of the page
 
ADezii
post Apr 10 2018, 03:19 PM
Post#5



Posts: 2,674
Joined: 4-February 07
From: USA, Florida, Delray Beach


Sorry Doug, didn't realize that I had stepped on your toes, twice! frown.gif
This post has been edited by ADezii: Apr 10 2018, 03:19 PM
Go to the top of the page
 
tlsn4
post Apr 10 2018, 06:14 PM
Post#6



Posts: 250
Joined: 12-August 03
From: Olympia, WA


Thanks Doug!! Worked perfectly!

And ADezii, I definitely appreciate the assistance as well.
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    13th October 2019 - 05:29 PM