MyTetra Share
Делитесь знаниями!
Вывод в Immediate Window всех обьектов где в источнике данных есть указанная строка
16.03.2019
23:43
Раздел: !Закладки - VBA - Access - msa.polarcom.ru - 10 Приложение MSA

Вывод в 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

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования