VBA, MS Access MS Access в примерах

Поиск значения среди всех текстовых полей всех таблиц (или указанной таблицы)

Public Sub FindStrInAllTables(sStringToFind$, Optional ByVal sTableName$ = "", _
                            Optional bClearMatch As Boolean = False)
' es 16.03.2020 - LE 11.02.2021 v002
'--------------------------------------------------------------------------
' Поиск значения среди всех полей - всех (или указанной) таблиц
' результаты выводятся в Immediate Окно
'--------------------------------------------------------------------------
'Аргументы:
'   sStringToFind = искомое текстовое значение
'   sTableName    = Опционально - название таблицы в которой ищем
'                   если не указано - ищем по всем таблицам ...
'   bClearMatch   = Опционально - частичное (по умлч.) или полное совпадение
'--------------------------------------------------------------------------
'Примеры эксплуотации:
'   FindStrInAllTables("василий")
'   или:
'   FindStrInAllTables "Выходной", "dtDaysOff", True
'--------------------------------------------------------------------------
Dim tdf As DAO.TableDef
Dim objField As DAO.Field
Dim cVal$, sTName$, sFName$, l&, lCount&
Dim bInAll As Boolean, iTblCount%
On Error GoTo FindStrInAllTables_Err

    If sStringToFind = "" Then
        MsgBox "Искомая стока не задана!", vbExclamation
        GoTo FindStrInAllTables_End
    End If
    
    bInAll = (sTableName = "") 'по всем или по конкретной
    
    cVal = String(72, "-")
    Debug.Print cVal
    
    For Each tdf In CurrentDb.TableDefs
        If (tdf.Attributes And dbSystemObject) = False Then
            sTName = tdf.Name
            If bInAll = True Then sTableName = sTName
            If sTName = sTableName Then
                iTblCount = iTblCount + 1
                For Each objField In tdf.Fields
                    'Только по полям: dbText = 10 и 12 = dbMemo
                    If objField.Type = 10 Or objField.Type = 12 Then
                        sFName = objField.Name
                        
                        If bClearMatch = True Then 'Полное совпадение:
                            cVal = "[" & sFName & "] = '" & sStringToFind & "'"
                        Else  'или частичное совпадение:
                            cVal = "[" & sFName & "] Like '*" & sStringToFind & "*'"
                        End If
                        l = DCount("*", "[" & sTName & "]", cVal)
                        If l > 0 Then
                            Debug.Print "Таблица: [" & sTName & _
                                "] - поле: [" & sFName & "] - вхождений: " & l
                            lCount = lCount + l
                        End If
                    End If
                Next objField
            End If
        End If
    Next tdf
'--------------------------------------------------------------------------
'Отчёт:
    If lCount > 0 Then
        cVal = String(72, "-")
        Debug.Print cVal
    End If
    
    cVal = "Обработано таблиц:" & iTblCount & vbCrLf & "Всего найдено: " & lCount & " вхождений."
    Debug.Print cVal

FindStrInAllTables_End:
    On Error Resume Next
    Set objField = Nothing
    Set tdf = Nothing
    Err.Clear
    Exit Sub

FindStrInAllTables_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub" & _
           "FindStrInAllTables - in module [Имя вашего модуля].", vbCritical, "Произошла ошибка!"
    'Debug.Print "FindStrInAllTables_Line: " & Erl & "."
    Err.Clear
    Resume FindStrInAllTables_End

End Sub


Назад ToTop
L.E. 11.02.2021
Рейтинг@Mail.ru