Search for a string in *all* usertables (1 Viewer)

Option Compare Database
Option Explicit

Public Function SearchInTables(strValue As String) As String
'Search in almost *all* tables.

    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim rst As Recordset
    Dim strSql As String
    
    Set db = CurrentDb()
    For Each tdf In db.TableDefs
    If Left$(tdf.Name, 4) <> "MSys" Then
        For Each fld In tdf.Fields
            If fld.Type = 10 Or fld.Type = 12 Then 'Text or Memo field
                strSql = "select [" & fld.Name & "] from " & tdf.Name & " where [" & fld.Name & "] like '*" & strValue & "*'"
                Set rst = CurrentDb.OpenRecordset(strSql)
                If Not rst.EOF Then
                    Debug.Print "Found in " & tdf.Name & ", field " & fld.Name & " value:" & rst.Fields(0)
                End If
                Set rst = Nothing
            End If
        Next fld
    End If
    Next tdf

    MsgBox "Done"

End Function

Debug.Print tdf.Name, fld.Name, fld.Type

Public Function SearchInTables(strValue As String, Optional strTablename As String = "", Optional lngThreshold As Long = 50000) As String

    Dim db               As DAO.Database
    Dim tdf              As DAO.TableDef
    Dim fld              As DAO.Field
    Dim rst              As Recordset
    Dim rstZ             As Recordset
    Dim strSql           As String
    Dim blnRecalc        As Boolean
    Dim lngAantalRecords As Long
    
    Set db = CurrentDb()
    For Each tdf In db.TableDefs
'        Debug.Print tdf.Name
        blnRecalc = True
        Do While 1 'Trick to jump to the next item using Exit Do.
            If Left$(tdf.Name, 4) <> "MSys" Then
                If Len(strTablename) > 0 Then
                    If strTablename <> tdf.Name Then
                        Exit Do
                    End If
                End If
                For Each fld In tdf.Fields
                    Debug.Print tdf.Name, fld.Name, fld.Type
                    If fld.Type = 10 Or fld.Type = 12 Then 'Text field
                        If blnRecalc Then
                            blnRecalc = False
                            strSql = "select [" & fld.Name & "] from [" & tdf.Name & "]"
                            Set rst = CurrentDb.OpenRecordset(strSql)
                            If rst.EOF Then Exit Do
                            rst.MoveLast: rst.MoveFirst
                            lngAantalRecords = rst.RecordCount
                            If lngAantalRecords >= lngThreshold Then
                                If vbNo = MsgBox("Table " & tdf.Name & " contains more than " & lngThreshold & " records. Continue search?", vbQuestion + vbYesNo) Then
                                    Exit Do
                                End If
                            End If
                        End If
                        rst.FindFirst """" & fld.Name & """ = """ & strValue & """"

                        If Not rst.NoMatch Then
                            Debug.Print "Found in " & tdf.Name & ", veld " & fld.Name & " value:" & rst.Fields(0)
                        End If
'                        Set rst = mog
                    End If
                Next fld
            Else
                Exit Do
            End If
            If Len(strTablename) > 0 Then
                Exit For
            Else
                Exit Do
            End If
        Loop
    Next tdf

    MsgBox "Done"

End Function