When you have a Microsoft Access database with a lot of macros, it can be a challenge to find all the places where an object is being used in the macros and replace it with a different object. These VBA functions will allow you to replace a value in a particular macro, or in all macros. They will also let you just export a macro to a text file, an alternative way to view the structure of a long macro.
The functions make use of the undocumented Application.SaveAsText and Application.LoadFromText methods. You can use these methods to export and import the design structure of any of the objects in the database.
GetMacroText() – This procedure exports a macro to a text file and then returns the text from the file. If you set RemoveFile to False, it leaves the text file so that you can view it or make changes to it manually.
UpdateMacro() – This procedure updates a macro with the text from MacroText. If you leave MacroText blank, it just uses the contents of FileName.
ReplaceInMacro() – This procedure replaces OldValue with NewValue in all macros, or in a specific macro. It looks for any occurrence of text that includes OldValue, so variations of OldValue will also be affected. It calls GetMacroText(), makes the replacement, and then calls UpdateMacro().
basEditMacro
' basEditMacro() Version 1.0.0
' Copyright © 2023 Extra Mile Data, www.extramiledata.com.
' For questions or issues, please contact [email protected].
' Use (at your own risk) and modify freely as long as proper credit is given.
'
Public Function GetMacroText(MacroName As String, FileName As String, _
Optional RemoveFile As Boolean = True)
' This procedure exports the MacroName macro to a text file and then returns
' the text from the file. If you set RemoveFile to False, it leaves the text
' file so that you can view it.
On Error GoTo Err_Handler
Dim strText As String
Dim intFile As String
Dim lngChars As Long
Dim strBuffer As String
' Delete the text file.
Kill FileName
' Export the macro to a text file.
Application.SaveAsText acMacro, MacroName, FileName
' Initialze the variable that will hold the text.
strText = ""
' Get a free file.
intFile = FreeFile
' Open the file. Loop though the file, adding each line
' to strText.
Open FileName For Input As intFile
Do While Not EOF(intFile)
Line Input #intFile, strBuffer
strText = strText & strBuffer & vbCrLf
Loop
' Close the text file.
Close intFile
If RemoveFile Then
' Delete the text file.
Kill FileName
End If
' Remove the leading spaces if there are some.
If Left(strText, 1) = " " Then
strText = Right(strText, Len(strText) - 1)
End If
If Left(strText, 1) = " " Then
strText = Right(strText, Len(strText) - 1)
End If
' Remove 2 leading special characters, like ÿþ.
' If we don't do this, UTF will be used instead of ANSI if we
' export the file, which will break an import of the file as a macro.
strText = Right(strText, Len(strText) - 2)
' Pass back the text.
GetMacroText = strText
Exit_Proc:
On Error Resume Next
Close intFile
Exit Function
Err_Handler:
Select Case Err.Number
Case 53
' File does not exist.
Resume Next
Case Else
MsgBox Err.Number & " " & Err.Description, vbCritical, "GetMacroText()"
GetMacroText = Null
Resume Exit_Proc
End Select
End Function
'
Function UpdateMacro(MacroName As String, FileName As String, _
Optional MacroText As String, Optional RemoveFile As Boolean) As Boolean
' This procedure updates the MacroName macro with the text from MacroText
' or the contents of FileName.
On Error GoTo Err_Handler
Dim intFile As Integer
' If there is MacroText, then output a file that can be imported.
If Len(MacroText) > 0 Then
' Delete the text file.
Kill FileName
' Get a free file.
intFile = FreeFile
' Send the text to the text file.
Open FileName For Append As intFile
Print #intFile, MacroText
Close intFile
End If
' Import the text file as a macro.
Application.LoadFromText acMacro, MacroName, FileName
If RemoveFile Then
' Delete the text file.
Kill FileName
End If
UpdateMacro = True
Exit_Proc:
On Error Resume Next
Close intFile
Exit Function
Err_Handler:
Select Case Err.Number
Case 53
' File does not exist.
Resume Next
Case Else
MsgBox Err.Number & " " & Err.Description, vbCritical, "UpdateMacro()"
UpdateMacro = False
Resume Exit_Proc
End Select
End Function
'
Public Function ReplaceInMacro(OldValue As String, NewValue As String, _
Optional MacroName As String) As Boolean
' This procedure replaces OldValue with NewValue in all macros, unless
' there is a MacroName, in which case it only replaces in that macro.
On Error GoTo Err_Handler
Dim aob As AccessObject
Dim strText As String
Dim strFileName As String
' Build the name of the temporary file that will hold the macro contents.
strFileName = CurrentProject.Path & "\TEMPMacroName.txt"
' Loop through all of the macros.
For Each aob In CurrentProject.AllMacros
' Continue if no MacroName was specified or it is the macro
' specified.
If Len(MacroName) = 0 Or aob.Name = MacroName Then
' Get the text from the macro.
strText = GetMacroText(aob.Name, strFileName)
' Make replacements in the macro text if the OldValue is found.
If InStr(1, strText, OldValue) > 0 Then
strText = Replace(strText, "frmMouseWheel", "frmAddControls")
' Update the macro with the new text.
UpdateMacro aob.Name, strFileName, strText
End If
End If
Next
ReplaceInMacro = True
Exit_Proc:
On Error Resume Next
Set aob = Nothing
Exit Function
Err_Handler:
MsgBox Err.Number & " " & Err.Description, vbCritical, "ReplaceInMacro()"
ReplaceInMacro = False
Resume Exit_Proc
End Function