Rambler's Top100
Российский фонд помощи
Навигация
Главная
MS ACCESS
VB
ASP
PHP
Наши друзья
Поиск
Форум
Лента новостей
Новый сайт

Online
Рассылки Subscribe.Ru
Работа с MS Access
Подписаться письмом
Реклама на сайте
 
Главная arrow MS ACCESS arrow Поиск встроенных макросов
Поиск встроенных макросов Печать E-mail
Автор Daniel Pineault   
15.10.2019 г.

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


Большинство людей уже знают, что я не одобряю встроенные макросы в любом качестве. В отличие от VBA, макросы более сложны в программировании, не имеют возможности поиска, что затрудняет выполнение обновлений базы данных.

 

Короче говоря, недавно я работал над проектом, в котором мне нужно было провести основную очистку имен объектов, имен элементов управления ... и мне нужно было определить, где используется объект, чтобы я мог обновить их. Тогда я решил, что еще лучше, давайте найдем все встроенные макросы, чтобы я мог просто преобразовать их в обычный VBA, и тогда эта проблема больше не возникнет в будущем.

 

Поэтому я собрал следующую процедуру, которая проходит через все формы и отчеты базы данных и их соответствующие элементы управления, чтобы определить те, которые используют встроенные макросы. Надеюсь, это может помочь кому-то еще.

 

'---------------------------------------------------------------------------------------

' Procedure : FindEmbeddedMacros

' Author    : Daniel Pineault, CARDA Consultants Inc.

' Website   : http://www.cardaconsultants.com

' Purpose   : Search Forms & Reports to locate any Embedded Macros

'             The search results are printed to the immediate window

' Copyright : The following is release as Attribution-ShareAlike 4.0 International

'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/

' Req'd Refs: Uses Late Binding, so none required

'

' Input Variables:

' ~~~~~~~~~~~~~~~~

' None

'

' Usage:

' ~~~~~~

' ?FindEmbeddedMacros

' Call FindEmbeddedMacros

'

' Revision History:

' Rev       Date(yyyy/mm/dd)        Description

' **************************************************************

' 1         2017-01-07              Initial Release

' 2         2018-05-24              Copyright updated

'---------------------------------------------------------------------------------------

Public Sub FindEmbeddedMacros()

    On Error GoTo Error_Handler

    Dim oFrm                  As Object

    Dim frm                   As Access.Form

    Dim oRpt                  As Object

    Dim rpt                   As Access.Report

    Dim ctl                   As Access.Control

    Dim prp                   As DAO.Property

 

    Access.Application.Echo False

    Debug.Print "Search Results"

    Debug.Print "Object Type", "Object Name", "Control Name", "Event Name"

    Debug.Print String(80, "-")

 

    'Search the forms

    For Each oFrm In Application.CurrentProject.AllForms

        DoCmd.OpenForm oFrm.Name, acDesign

        Set frm = Forms(oFrm.Name).Form

        With frm

            For Each prp In .Properties

                'Form Properties

                If InStr(prp.Name, "EMMacro") > 0 Then

                    If Len(prp.value) > 0 Then

                        Debug.Print "Form", frm.Name, , Replace(prp.Name, "EmMacro", "")

                    End If

                End If

            Next prp

            'Form Control Properties

            For Each ctl In frm.Controls

                For Each prp In ctl.Properties

                    If InStr(prp.Name, "EMMacro") > 0 Then

                        If Len(prp.value) > 0 Then

                            Debug.Print "Form", frm.Name, ctl.Name, Replace(prp.Name, "EmMacro", "")

                        End If

                    End If

                Next prp

            Next ctl

        End With

        DoCmd.Close acForm, oFrm.Name, acSaveNo

    Next oFrm

 

    'Search the Reports

    For Each oRpt In Application.CurrentProject.AllReports

        DoCmd.OpenReport oRpt.Name, acDesign

        Set rpt = Reports(oRpt.Name).Report

        With rpt

            'Report Properties

            For Each prp In .Properties

                If InStr(prp.Name, "EmMacro") > 0 Then

                    If Len(prp.value) > 0 Then

                        Debug.Print "Report", rpt.Name, , Replace(prp.Name, "EmMacro", "")

                    End If

                End If

            Next prp

            'Report Control Properties

            For Each ctl In rpt.Controls

                For Each prp In ctl.Properties

                    If InStr(prp.Name, "EMMacro") > 0 Then

                        If Len(prp.value) > 0 Then

                            Debug.Print "Report", rpt.Name, ctl.Name, Replace(prp.Name, "EmMacro", "")

                        End If

                    End If

                Next prp

            Next ctl

        End With

        DoCmd.Close acReport, oRpt.Name, acSaveNo

    Next oRpt

 

    Debug.Print String(80, "-")

    Debug.Print "Search Completed"

 

Error_Handler_Exit:

    On Error Resume Next

    Access.Application.Echo True

    If Not prp Is Nothing Then Set prp = Nothing

    If Not ctl Is Nothing Then Set ctl = Nothing

    If Not rpt Is Nothing Then Set rpt = Nothing

    If Not oRpt Is Nothing Then Set oRpt = Nothing

    If Not frm Is Nothing Then Set frm = Nothing

    If Not oFrm Is Nothing Then Set oFrm = Nothing

    Exit Sub

 

Error_Handler:

    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _

           "Error Number: " & Err.Number & vbCrLf & _

           "Error Source: FindEmbeddedMacros" & vbCrLf & _

           "Error Description: " & Err.Description & _

           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _

           , vbOKOnly + vbCritical, "An Error has Occurred!"

    Resume Error_Handler_Exit

End Sub

 

Источник MS Access – Find Embedded Macros


Просмотров: 71

  Ваш коментарий будет первым

Добавить коментарий
Имя:
E-mail
Коментарий:



Код:* Code

 
Реклама на сайте
HiProg.com - Технологии программирования
Rambler's Top100 TopList