|
|
Поиск значения среди всех текстовых полей всех таблиц (или указанной таблицы)
Public Sub FindStrInAllTables(sStringToFind$, Optional ByVal sTableName$ = "", _
Optional bClearMatch As Boolean = False)
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
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, "Произошла ошибка!"
Err.Clear
Resume FindStrInAllTables_End
End Sub
|
|