Поиск во встроенных и стандартных макросах |
Автор Daniel Pineault | ||||||
30.10.2019 г. | ||||||
Не так давно я размещал код Даниэля Пино о поиске встроенных макросов в формах и отчётах Получить список встроенных макросов И вот у того же Даниэля Пино натолкнулся на подпрограмму, которая производила поиск по содержимому во встроенных и стандартных макросах. Как пишет сам Даниэль Пино, он её разрабатывал, чтобы определить, откуда вызывались формы, чтобы заменить одни формы на другие.
Исходная статья MS Access – Find Macros Using a Search Term '--------------------------------------------------------------------------------------- ' Procedure : FindTermInMacros ' Author : Daniel Pineault, CARDA Consultants Inc. ' Website : http://www.cardaconsultants.com ' Purpose : Search through Form and Report Embedded Macros and standard Macros for ' a given term ' 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: ' ~~~~~~~~~~~~~~~~ ' sSearchTerm The term to look form ' ' Usage: ' ~~~~~~ ' Call FindTermInMacros("Form1") ' Call FindTermInMacros("SetTempVar") ' ' Revision History: ' Rev Date(yyyy/mm/dd) Description ' ************************************************************************************** ' 1 2017-01-07 Initial Release ' 2 2017-05-22 Added search of standard Macros ' 3 2018-09-20 Updated Copyright '--------------------------------------------------------------------------------------- Public Function FindTermInMacros(sSearchTerm As String) 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 oMcr As Object Dim prp As DAO.Property Dim sFile As String Dim sMcr As String Dim intChannel As Integer Dim sLine As String
Access.Application.Echo False Debug.Print "Search Results for the Term '" & sSearchTerm & "'" Debug.Print "Object Type", "Object Name", "Control Name", "Event Name" Debug.Print String(80, "-")
'Search Forms For Each oFrm In Application.CurrentProject.AllForms DoCmd.OpenForm oFrm.Name, acDesign Set frm = Forms(oFrm.Name).Form With frm 'Form Properties For Each prp In .Properties If InStr(prp.Name, "EmMacro") > 0 Then If Len(prp.Value) > 0 Then 'Search for the Search Term we are looking for If InStr(prp.Value, sSearchTerm) > 0 Then Debug.Print "Form:", frm.Name, , Replace(prp.Name, "EmMacro", "") ', prp.Value End If 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 If InStr(prp.Value, sSearchTerm) > 0 Then Debug.Print "Form", frm.Name, ctl.Name, Replace(prp.Name, "EmMacro", "") End If End If End If Next prp Next ctl End With DoCmd.Close acForm, oFrm.Name, acSaveNo Next oFrm
'Search 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 'Search for the Search Term we are looking for If InStr(prp.Value, sSearchTerm) > 0 Then Debug.Print "Report:", rpt.Name, , Replace(prp.Name, "EmMacro", "") ', prp.Value End If 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 If InStr(prp.Value, sSearchTerm) > 0 Then Debug.Print "Form", frm.Name, ctl.Name, Replace(prp.Name, "EmMacro", "") End If End If End If Next prp Next ctl End With DoCmd.Close acReport, oRpt.Name, acSaveNo Next oRpt
'Search Standard Macros 'There appears to be no way to simply read/access a macro's commands through VBA, so 'we have to export the object to a text file and then read and search the resulting 'file. It's just the way it is, thank MS for not giving us any mean to interact with 'macros! For Each oMcr In Application.CurrentProject.AllMacros sFile = Access.Application.CurrentProject.Path & "\Macro_" & oMcr.Name & ".txt" 'Export the Macro to a Text file so we can review it Access.Application.SaveAsText acMacro, oMcr.Name, sFile 'Read the text file sMcr = "" intChannel = FreeFile Open sFile For Input Access Read As #intChannel Do Until EOF(intChannel) Line Input #intChannel, sLine If Trim(sLine) Like "Comment =""_AXL:<?xml version=*" Then _ Exit Do sMcr = sMcr & sLine Loop Close #intChannel 'Delete the text file now that we have the content in memory Kill sFile 'Search for the Search Term we are looking for If InStr(sMcr, sSearchTerm) > 0 Then Debug.Print "Macro:", oMcr.Name End If Next oMcr
Debug.Print String(80, "-") Debug.Print "Search Completed"
Error_Handler_Exit: On Error Resume Next Access.Application.Echo True If Not oMcr Is Nothing Then Set oMcr = Nothing 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 Function
Error_Handler: MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: FindTermInMacros" & vbCrLf & _ "Error Description: " & vbCrLf & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf) _ , vbOKOnly + vbCritical, "An Error has Occurred!" Resume Error_Handler_Exit End Function Просмотров: 1304
|