KevinWilcox
New member
- Local time
- Today, 00:33
- Joined
- Jan 27, 2022
- Messages
- 17
Hi, I have found some code, appended, written by Dev Ashish many years ago that allows me to search all tables for a string match. This is great but I now need to return the value of one field from the results. Longhand, what I want to do is specify that if the result comes from Table X, return the value of field Y.
I've been able to figure out how to do the 'if it comes from table X' bit, but I'm stuck on 'return the value of field Y'. I've tried all manner of things to refer to it, e.g. fieldname(0), columnnames(0) but none of them work. Can anyone tell me what that line needs to be?
Define a new class call 'SearchResults' and put these members in it.
' ***
Public TableName As String
Public ColumnNames As New VBA.Collection
Public ResultRows As New VBA.Collection
' ***
Put these 2 procs in a standard module and run 'TestSearchAllTables'. The
actual work is done in SearchAllTables routines. You can modify the SQL
in it so that only one column is searched against if you need to figure
out which particular column contained the string instead of the table.
-- Dev
I've been able to figure out how to do the 'if it comes from table X' bit, but I'm stuck on 'return the value of field Y'. I've tried all manner of things to refer to it, e.g. fieldname(0), columnnames(0) but none of them work. Can anyone tell me what that line needs to be?
Define a new class call 'SearchResults' and put these members in it.
' ***
Public TableName As String
Public ColumnNames As New VBA.Collection
Public ResultRows As New VBA.Collection
' ***
Put these 2 procs in a standard module and run 'TestSearchAllTables'. The
actual work is done in SearchAllTables routines. You can modify the SQL
in it so that only one column is searched against if you need to figure
out which particular column contained the string instead of the table.
Code:
' ***
Sub TestSearchAllTables()
Dim results As VBA.Collection
Dim result As SearchResults
Dim i As Integer, j As Integer, k As Integer
Set results = SearchAllTables("An")
If results.Count > 0 Then
For i = 1 To results.Count
Set result = results.item(i)
With result
Debug.Print "***************"
Debug.Print "Result found in: " & .TableName
Debug.Print "***************"
For j = 1 To .ColumnNames.Count
Debug.Print .ColumnNames.item(j),
Next
Debug.Print
Debug.Print "---------------------"
For j = 1 To .ResultRows.Count
For k = 0 To .ColumnNames.Count - 1
Debug.Print .ResultRows.item(j)(k),
Next
Next
Debug.Print
End With
Next
Else
Debug.Print "No records found"
End If
End Sub
Function SearchAllTables(criteria As String) As VBA.Collection
Dim rs As dao.Recordset
Dim tdf As dao.TableDef
Dim db As dao.Database
Dim fld As dao.Field
Dim sql As String, i As Integer, j As Integer
Dim doInclude As Boolean
Dim results As VBA.Collection
Dim item As SearchResults, items() As String
On Error GoTo ErrHandler
Set db = CurrentDb
Set results = New VBA.Collection
For Each tdf In db.TableDefs
doInclude = (Not CBool(tdf.Attributes And _
dbSystemObject)) And _
(Not CBool(tdf.Attributes And dbHiddenObject))
If (doInclude) Then
sql = "select * from [" & tdf.Name & _
"] where "
For Each fld In tdf.Fields
sql = sql & "[" & fld.Name & "] like '*" & _
criteria & "*' or "
Next
sql = Left$(sql, Len(sql) - 3)
Set rs = db.OpenRecordset(sql)
If (rs.RecordCount > 0) Then
Set item = New SearchResults
item.TableName = tdf.Name
rs.MoveFirst
ReDim items(0 To rs.Fields.Count - 1)
For i = 0 To rs.RecordCount - 1
For j = 0 To rs.Fields.Count - 1
items(j) = rs.Fields(j).Value & vbNullString
Next
item.ResultRows.Add items
rs.MoveNext
Next
For j = 0 To rs.Fields.Count - 1
item.ColumnNames.Add rs.Fields(j).Name
Next
results.Add item:=item, Key:=tdf.Name
End If
rs.Close
End If
Next
Set SearchAllTables = results
Set tdf = Nothing
Set fld = Nothing
Set rs = Nothing
Set db = Nothing
Exit Function
ErrHandler:
With Err
MsgBox "Error: " & .Number & vbCrLf & _
.Description, vbOKOnly Or vbCritical, "SearchAllTables"
End With
Set tdf = Nothing
Set fld = Nothing
Set rs = Nothing
Set db = Nothing
End Function
' ***
-- Dev
Last edited by a moderator: