'---------------------------------------------------------------------------------------
' 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
Ваш коментарий будет первым