505.369.1650 [email protected]

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