I did come across this article, but I don't know how to
adapt it to make it work in Access:
http://vyaskn.tripod.com/search_all_columns_in_all_tables.h
tm
That's effectively a function if you were to translate it to VBA.
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.
' ***
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