Порой наступает такой момент, что в базе нужно что-то изменить, но уже не помнишь всех связей или никогда не знал, поскольку правишь чужой проект.
На такой случай сделал две формы.
1-я) Осуществляет поиск чего-либо в текстах всех запросов, сохранённых в базе и в источниках строк полей таблиц, если есть подстановочные поля.
2-я) Ищет формы и их элементы, в которых использованы те или иные запросы.

За одно, в них реализован "массовый" поиск неиспользуемых запросов.

В атаче архив базы, сделанной в 2010-м аксесе.
(в 2003-й не получилось сохранить)

Для тех, кто не сможет открыть этот файл:

- Текст первой формы

Form_frmAdmLookForQuery.cls

 

Visual BasicВыделить код

 

VERSION 1.0 CLASS

BEGIN

  MultiUse = -1  'True

END

Attribute VB_Name = "Form_frmAdmLookForQuery"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = True

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

Option Compare Database

Option Explicit

 

Private Const coTitle As String = "Поиск запросов"

 

Private Sub cmdLookAll_Click()

    If vbYes <> MsgBox("Получить список имён неиспользуемых запросов? " & vbCr _

                        & "Это может занять значительное время." _

                        , vbYesNo + vbQuestion, coTitle) _

    Then Exit Sub

   

    Dim blnPresent As Boolean

    Dim blnRS As Boolean

    Dim blnRST As Boolean

    Dim fld As Field

    Dim objQueryLF As QueryDef

    Dim objQueryLI As QueryDef

    Dim prp As Property

    Dim strLookFor As String

    Dim strQueryName As String

    Dim strSQL As String

    Dim strTabName As String

    Dim td As TableDef

   

    On Error GoTo ErrorHandler

   

    ' отключаем обновление экрана

    Application.Echo False, "Идёт получение списка имён неиспользуемых запросов. " _

                            & "Это может занять значительное время. Подождите..."

   

    ' очищаем список запросов перед поиском

    Me.lstQuery.RowSource = ""

       

    ' ищем запросы в запросах, сохранённых в базе

    Me.lstQuery.AddItem "----- Начало списка -----"

    For Each objQueryLF In CurrentDb.QueryDefs

        strLookFor = objQueryLF.Name

        If Left(strLookFor, 1) <> "~" Then

            blnPresent = False

            ' перечитываем запросы, сохранённые в базе

            For Each objQueryLI In CurrentDb.QueryDefs

                strQueryName = objQueryLI.Name

                If Left(strQueryName, 1) <> "~" Then

                    ' если запрос содержит в теле искомую строку

                    If InStr(1, objQueryLI.SQL, strLookFor, vbTextCompare) > 0 Then

                        ' отмечаем, что данный запрос используется

                        blnPresent = True

                        Exit For

                    End If

                End If

            Next objQueryLI

           

            ' если искомый запрос не обнаружен

            If Not blnPresent Then

                ' добавляем имя запроса в список, если ренее не добавили

                Call AddInListBox(strLookFor, strLookFor)

            End If

        End If

    Next objQueryLF

   

    ' ищем запросы в таблицах, сохранённых в базе

    Me.lstQuery.AddItem "----- Конец списка -----"

    For Each objQueryLF In CurrentDb.QueryDefs

        strLookFor = objQueryLF.Name

        If Left(strLookFor, 1) <> "~" Then

            ' перечитываем все таблицы, сохранённые в базе

            For Each td In CurrentDb.TableDefs

                strTabName = td.Name

                If Left(strTabName, 4) <> "MSys" _

                And Left(strTabName, 4) <> "USys" _

                And Left(strTabName, 7) <> "tblSinc" _

                Then

                    For Each fld In td.Fields

                        blnRS = False

                        blnRST = False

                        

                        For Each prp In fld.Properties

                            If prp.Name = "RowSourceType" Then blnRST = True

                            If prp.Name = "RowSource" Then blnRS = True

                        Next prp

                       

                        ' если это подстановочное поле

                        If blnRS And blnRST Then

                            ' если источник строк содержит искомую строку

                            If InStr(1, fld.Properties("RowSource").Value, strLookFor, vbTextCompare) > 0 Then

                                ' отмечаем, что данный запрос используется

                                blnPresent = True

                                Exit For

                            End If

                        End If

                    Next fld

                   

                    ' если искомый запрос обнаружен

                    If blnPresent Then

                        ' удаляем имя запроса из списка

                        Me.lstQuery.RowSource = Replace(Me.lstQuery.RowSource, ";" & strQueryName & ";", ";")

                    End If

                End If

            Next td

        End If

    Next objQueryLF

   

    ' включаем обновление экрана

    Application.Echo True, "Получение свойств завершено."

    MsgBox "Обработка окончена", , coTitle

   

    Exit Sub

   

ErrorHandler:

    Call ErrMsg(Me.Caption) ' матюгальник

    Resume Next

End Sub

 

Private Sub cmdLookFor_Click()

    ' получаем список запросов, содержащих введённый текст, а также

    ' таблиц и их полей, у которых источник строк содержит введённый текст

       

    'If vbYes <> MsgBox("Произвести поиск запросов по образцу?" _

    '                    , vbYesNo + vbQuestion, coTitle) _

    'Then Exit Sub

   

    Dim blnRS As Boolean

    Dim blnRST As Boolean

    Dim fld As Field

    Dim objQueryLI As QueryDef

    Dim prp As Property

    Dim strLookFor As String

    Dim strQueryName As String

    Dim strSQL As String

    Dim strTabName As String

    Dim td As TableDef

   

    On Error GoTo ErrorHandler

   

    strLookFor = SpecSimvOchist(Nz(Me.txbLookFor.Value, ""), True)

    If strLookFor <> "" Then

        ' отключаем обновление экрана

        Application.Echo False, "Идёт получение свойств. Это может занять значительное время. Подождите..."

       

        ' очищаем список запросов перед поиском

        Me.lstQuery.RowSource = ""

       

        ' получаем список запросов, содержащих введённый текст

        Me.lstQuery.AddItem "----- Запросы -----"

        ' перечитываем все запросы, сохранённые в базе

        For Each objQueryLI In CurrentDb.QueryDefs

            strQueryName = objQueryLI.Name

            If Left(strQueryName, 1) <> "~" Then

                ' если запрос содержит в теле искомую строку

                If InStr(1, objQueryLI.SQL, strLookFor, vbTextCompare) > 0 Then

                    ' добавляем имя запроса в список, если ренее не добавили

                    Call AddInListBox(strQueryName, strQueryName)

                End If

            End If

        Next objQueryLI

       

        ' получаем список таблиц и их полей, у которых источник строк содержит введённый текст

        Me.lstQuery.AddItem "----- Таблицы -----"

        ' перечитываем все таблицы, сохранённые в базе

        For Each td In CurrentDb.TableDefs

            strTabName = td.Name

            If Left(strTabName, 4) <> "MSys" _

            And Left(strTabName, 4) <> "USys" _

            And Left(strTabName, 7) <> "tblSinc" _

            Then

                For Each fld In td.Fields

                    blnRS = False

                    blnRST = False

                   

                    For Each prp In fld.Properties

                        If prp.Name = "RowSourceType" Then blnRST = True

                        If prp.Name = "RowSource" Then blnRS = True

                    Next prp

                   

                    ' если это подстановочное поле

                    If blnRS And blnRST Then

                        ' если источник строк содержит искомую строку

                        If InStr(1, fld.Properties("RowSource").Value, strLookFor, vbTextCompare) > 0 Then

                            ' добавляем имя таблицы в список, если ренее не добавили

                            Call AddInListBox(strTabName, strTabName)

                            ' добавляем имя поля в список, если ренее не добавили

                            Call AddInListBox(fld.Name, ".          " & fld.Name)

                        End If

                    End If

                Next fld

            End If

        Next td

       

        ' включаем обновление экрана

        Application.Echo True, "Получение свойств завершено."

        MsgBox "Обработка окончена", , coTitle

    Else

        MsgBox "Поиск запросов по образцу не возможен, т.к. не указан образец поиска?" _

                , vbExclamation, coTitle

    End If

   

    Exit Sub

   

ErrorHandler:

    Call ErrMsg(Me.Caption) ' матюгальник

    Resume Next

End Sub

 

Private Sub Form_Unload(Cancel As Integer)

    Me.txbLookFor.Value = Null

    Me.lstQuery.RowSource = ""

End Sub

 

Private Function AddInListBox( _

        strLookFor As String _

        , strAdd As String _

        ) As Boolean

   

    On Error GoTo ErrorHandler

   

    If InStr(1, Me.lstQuery.RowSource, strLookFor, vbTextCompare) = 0 Then

        Me.lstQuery.AddItem strAdd

        AddInListBox = True

    Else

        AddInListBox = False

    End If

   

    Exit Function

   

ErrorHandler:

    Call ErrMsg(Me.Caption) ' матюгальник

    Resume Next

End Function

 

 

 

- Текст второй формы

Form_frmAdmLookForQueryOnForm.cls

 

Visual BasicВыделить код

 

 

 

VERSION 1.0 CLASS

BEGIN

  MultiUse = -1  'True

END

Attribute VB_Name = "Form_frmAdmLookForQueryOnForm"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = True

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

Option Compare Database

Option Explicit

 

Const coTitle As String = "Поиск форм и их элементов"

   

Private Sub cmdLookAll_Click()

    If vbYes <> MsgBox("Получить список имён неиспользуемых запросов? " & vbCr _

                        & "Это может занять значительное время." _

                        , vbYesNo + vbQuestion, coTitle) _

    Then Exit Sub

   

    Dim blnPresent As Boolean

    Dim ctl As Control

    Dim objFrm As AccessObject

    Dim prp As Property

    Dim q As Long

    Dim strObjName As String

    Dim strSource As String

    Dim strLookFor As String

   

    On Error GoTo ErrorHandler

   

    ' отключаем обновление экрана

    Application.Echo False, "Идёт получение списка имён неиспользуемых запросов. " _

                            & "Это может занять значительное время. Подождите..."

   

    ' очищаем список запросов перед поиском

    Me.lstQuery.RowSource = ""

   

    For q = 0 To lstLookFor.ListCount - 1

        strLookFor = lstLookFor.Column(0, q)

        If strLookFor <> "" Then

            blnPresent = False

            ' перечитываем все формы, сохранённые в базе

            For Each objFrm In CurrentProject.AllForms

                strObjName = objFrm.Name

                Select Case strObjName

                    ' список форм, исключённых из обработки

                    Case Is = Me.Name, "Заставка", "frmAdmLookForQuery"

                    Case Else

                        ' открываем форму

                        DoCmd.OpenForm strObjName, acDesign

                       

                        ' выбираем свойство "источник записей"

                        Set prp = Forms(strObjName).Properties("RecordSource")

                        ' изсеняем источник данных

                        If Not IsNull(prp.Value) Then

                            strSource = prp.Value

                            If InStr(1, strSource, strLookFor, vbTextCompare) > 0 Then

                                blnPresent = True

                            End If

                        End If

                       

                        If Not blnPresent Then

                            ' перечитываем элементы формы

                            For Each ctl In Forms(strObjName).Controls

                                ' выбираем свойство "тип элемента"

                                Set prp = ctl.Properties("ControlType")

                                ' если это ComboBox

                                If prp.Value = 111 Then

                                    ' выбираем свойство "источник строк"

                                    Set prp = ctl.Properties("RowSource")

                                    ' изсеняем источник данных

                                    If Not IsNull(prp.Value) Then

                                        strSource = prp.Value

                                        If InStr(1, strSource, strLookFor, vbTextCompare) > 0 Then

                                            blnPresent = True

                                            Exit For

                                        End If

                                    End If

                                End If

                            Next ctl

                        End If

                       

                        ' закрываем форму с сохранением изменений

                        DoCmd.Close acForm, strObjName, acSaveNo

                       

                        ' выходим из цыкла, если нашла запрос

                        If blnPresent Then Exit For

                End Select

            Next objFrm

           

            If Not blnPresent Then

                If InStr(1, Me.lstQuery.RowSource, strLookFor, vbTextCompare) = 0 Then

                    Me.lstQuery.AddItem strLookFor

                End If

            End If

        End If

    Next q

   

    ' включаем обновление экрана

    Application.Echo True, "Получение свойств завершено."

    MsgBox "Обработка окончена", , coTitle

   

    Exit Sub

   

ErrorHandler:

    Call ErrMsg(Me.Caption) ' матюгальник

    Resume Next

End Sub

 

Private Sub cmdLookFor_Click()

    If vbYes <> MsgBox("Произвести поиск форм и их элементов по имени запроса с которым они связаны?" _

                        , vbYesNo + vbQuestion, coTitle) _

    Then Exit Sub

   

    Dim ctl As Control

    Dim objFrm As AccessObject

    Dim prp As Property

    Dim strObjName As String

    Dim strSource As String

    Dim strLookFor As String

   

    On Error GoTo ErrorHandler

   

    strLookFor = SpecSimvOchist(Nz(Me.txbLookFor.Value, ""), True)

    If strLookFor <> "" Then

        ' отключаем обновление экрана

        Application.Echo False, "Идёт получение свойств. Это может занять значительное время. Подождите..."

       

        ' очищаем список запросов перед поиском

        Me.lstQuery.RowSource = ""

       

        ' перечитываем все формы, сохранённые в базе

        For Each objFrm In CurrentProject.AllForms

            strObjName = objFrm.Name

            Select Case strObjName

                ' список форм, исключённых из обработки

                Case Is = Me.Name, "Заставка", "frmAdmLookForQuery"

                Case Else

                    ' открываем форму

                    DoCmd.OpenForm strObjName, acDesign

                   

                    ' выбираем свойство "источник записей"

                    Set prp = Forms(strObjName).Properties("RecordSource")

                    ' изсеняем источник данных

                    If Not IsNull(prp.Value) Then

                        strSource = prp.Value

                        If InStr(1, strSource, strLookFor, vbTextCompare) > 0 Then

                            Me.lstQuery.AddItem strObjName

                        End If

                    End If

                   

                    ' перечитываем элементы формы

                    For Each ctl In Forms(strObjName).Controls

                        ' выбираем свойство "тип элемента"

                        Set prp = ctl.Properties("ControlType")

                        ' если это ComboBox

                        If prp.Value = 111 Then

                            ' выбираем свойство "источник строк"

                            Set prp = ctl.Properties("RowSource")

                            ' изсеняем источник данных

                            If Not IsNull(prp.Value) Then

                                strSource = prp.Value

                                If InStr(1, strSource, strLookFor, vbTextCompare) > 0 Then

                                    Me.lstQuery.AddItem ctl.Name & " on " & strObjName

                                End If

                            End If

                        End If

                    Next ctl

                   

                    ' закрываем форму с сохранением изменений

                    DoCmd.Close acForm, strObjName, acSaveNo

            End Select

        Next objFrm

       

        ' включаем обновление экрана

        Application.Echo True, "Получение свойств завершено."

        MsgBox "Обработка окончена", , coTitle

    Else

        MsgBox "Поиск запросов по образцу не возможен, т.к. не указан образец поиска?" _

                , vbExclamation, coTitle

    End If

   

    Exit Sub

   

ErrorHandler:

    Call ErrMsg(Me.Caption) ' матюгальник

    Resume Next

End Sub

 

Private Sub Form_Unload(Cancel As Integer)

    txbLookFor.Value = Null

    lstQuery.RowSource = ""

    lstLookFor.RowSource = ""

End Sub

 

 

 

- Функция

ErrMsg

 

Visual BasicВыделить код

 

 

Public Sub ErrMsg( _

        Optional strTitle As String = "Error" _

        )

    If Err <> 0 Then

        MsgBox Err.Source & " --> " & Err.Description, , strTitle

        Err.Clear

    End If

End Sub

Вложения

Database.zip (31.3 Кб, 722 просмотров)

Последний раз редактировалось Ameli; 12.02.2012 в 23:04.