To continue my original post, entitled MS Access – Find Embedded Macros, regarding identifying where Embedded Macro were being used within an Access database, I also develop the following procedure that enable one to search through all Embedded Macros and Standard Macros for a search term. The search term can be anything, object names, commands, segments of words, …
I originally was using this to identify where Forms were being called since I needed to rename them.
'---------------------------------------------------------------------------------------
' 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: 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: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
Thank you vary very much!
This helped a lot!
Private Declare Sub CloseHscr Lib "msaccess.exe" Alias "#20" ( _ ByVal hScr As Long) Private Declare Function FNextHscr Lib "msaccess.exe" Alias "#22" ( _ ByVal hScr As Long, _ ByVal fSkipBlank As Long, _ pfEndOfScript As Long) As Long Private Declare Function ActidOfHscr Lib "msaccess.exe" Alias "#29" ( _ ByVal hScr As Long) As Long Private Declare Function IdsArgNameOfActidIarg Lib "msaccess.exe" Alias "#33" ( _ ByVal actid As Long, _ ByVal iArg As Long) As Long Function GetMacroDetails(strMacro As String) As String Dim hScr As Long, fof As Long, actid As Long, cnt As Long Dim i As Long, n As Long, num As Long Dim strTemp As String, sVal As String WizHook.Key = 51488399 hScr = WizHook.OpenScript(strMacro, "", 0, i, n) If (hScr > 0) Then While (FNextHscr(hScr, False, fof)) num = num + 1 actid = ActidOfHscr(hScr) strTemp = strTemp & num & ". " & WizHook.NameFromActid(actid) & " (" cnt = WizHook.ArgsOfActid(actid) If cnt = 0 Then For n = 3 To cnt + 2 i = IdsArgNameOfActidIarg(actid, n) Call WizHook.GetScriptString(hScr, n, sVal) strTemp = strTemp & sVal & ", " Next n strTemp = Left(strTemp, Len(strTemp) - 2) & ")" Else strTemp = Left(strTemp, Len(strTemp) - 1) End If strTemp = strTemp & vbNewLine Wend CloseHscr hScr End If GetMacroDetails = strTemp Debug.Print GetMacroDetails End Function Function CreateMacro(ByVal vstrNewMacroName As String) As Long Dim hScr As Long Dim lngVersion As Long Dim lngExtra As Long WizHook.Key = 51488399 hScr = WizHook.OpenScript(vstrNewMacroName, "", 2&, lngExtra, lngVersion) If hScr = 0 Then CloseHscr hScr ' End If CreateMacro = hScr End Function Function EnumMacro() Dim dbs As Database Dim docLoop As Document Set dbs = CurrentDb() For Each docLoop In dbs.Containers("Scripts").Documents GetMacroDetails docLoop.Name Next End FunctionNote: Edited by the webmaster to correct minor coding issues.
Hello Daniel,
I was thinking about writing a code to transform all the embedded macro’s in a database to an Event Procedure.
The idea is to save the embedded macro to a textfile (or string) and modify the text to a normal acMacro. Save the modified text as an acMacro, convert this acMacro to vba with the correct name and set the form control to [Event Procedure]. What do you think, might this work?
I’m wondering if you couldn’t open each form in design view and use
to perform the conversion.