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

Вывод в Immediate Window всех обьектов где в источнике данных есть указанная строка


* Показать - Скрыть Immediate Window = Ctrl + G

Public Sub ObjectsWStrInRecSrc(sLookForStr$)
'es 25.12.2017
' Выводим в Immediate Window:
' Список всех обьектов где в источнике данных есть строка указанная в аргументе
'--------------------------------------------------------------------------
' Пример эксплуотации в Immediate Window: ObjectsWStrInRecSrc("Классы")
'--------------------------------------------------------------------------

Dim dbs As Database, qdf As QueryDef
Dim objMSA As AccessObject
Dim s$, sSQL$, sLookFor$
On Error GoTo ObjectsWStrInRecSrc_Err
    Set dbs = CurrentDb

'Поиск по запросам ...
    For Each qdf In dbs.QueryDefs
      sSQL = qdf.SQL
      If InStr(sSQL, sLookForStr) Then Debug.Print "Запрос: " & qdf.Name
    Next
    
'Поиск по формам ...
    For Each objMSA In CurrentProject.AllForms
        s = objMSA.Name
        DoCmd.OpenForm s, acDesign, , , , acHidden
        sSQL = Forms(s).RecordSource
         If InStr(sSQL, sLookForStr) Then Debug.Print "Форма: " & qdf.Name
        DoCmd.Close acForm, s, acSaveNo
    Next

'Поиск по отчётам ...
    For Each objMSA In CurrentProject.AllReports
        s = objMSA.Name
        DoCmd.OpenReport s, acViewDesign
        sSQL = Forms(s).RecordSource
         If InStr(sSQL, sLookForStr) Then Debug.Print "Отчёт: " & qdf.Name
        DoCmd.Close acReport, s, acSaveNo
    Next

ObjectsWStrInRecSrc_Bye:
    Exit Sub

ObjectsWStrInRecSrc_Err:
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in Sub: ObjectsWStrInRecSrc in module: mod_CommonApplication", vbCritical, "Error in Application: " & Err.Source
    Err.Clear
    Resume ObjectsWStrInRecSrc_Bye
End Sub
Назад ToTop
L.E. 25.12.2017
Рейтинг@Mail.ru