Editing macro design using VBA (1 Viewer)

Public Function ModifyMacroVBA(strMacroName, strFind, strReplace)

On Error GoTo Err_Handler

    'Const ForReading = 1
    'Const ForWriting = 2

    Dim objFSO As Object
    Dim objFile As Object
    'Dim strOldText As String
    'Dim strNewText As String
    
   ' Dim strBuf As String
    Dim strTemp As String
  '  Dim iFileNum As Integer
    Dim strFileName As String
  '  Dim filesys As Variant
    Dim tempfile As Object
    Dim file As Object
    Dim CurrentLine As String
    Dim NewLine As String
    'Dim strMacroName As String

'1. save macro to text file in same folder
    Path = Application.CurrentProject.Path
    strFileName = Path & "\" & strMacroName & ".txt"
  ' Debug.Print strMacroName, strFilename
   ' Application.SaveAsText acMacro, strMacroName, strFileName
    
    'Exit Function

'2. modify the text file
    '================================
    'THIS DOESN'T WORK for macros-'corrupts' the text
    
    'create a temp file then output the edited file contents
    strTemp = Path & "\" & strMacroName & ".tmp"
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile(strTemp, True)
    
    'open the original file and for each line replace any matching text
    Set file = objFSO.OpenTextFile(strFileName)
    Do Until file.AtEndOfStream
        CurrentLine = file.ReadLine
        NewLine = Replace(CurrentLine, strFind, strReplace, , , vbTextCompare)
        'write to the new line containing replacements to the temp file
        objFile.WriteLine NewLine
    Loop
    file.Close
    
    objFile.Close
    
    'delete the original file and replace with the temporary file
    objFSO.DeleteFile strFileName, True
    objFSO.MoveFile strTemp, strFileName

'===================
   Previous attempt - also failed
   ' Set objFSO = CreateObject("Scripting.FileSystemObject")
   ' Set objFile = objFSO.OpenTextFile(strFilename, ForReading)

   ' strOldText = objFile.ReadAll

   ' objFile.Close

  '  strNewText = Replace(strOldText, strFind, strReplace)
   '' Debug.Print strNewText

   ' Set objFile = objFSO.OpenTextFile(strFilename, ForWriting)

   ' objFile.WriteLine strNewText

   ' objFile.Close  
'===================  
    

'3. import the text file overwriting the existing macro
    Application.LoadFromText acMacro, strMacroName, strFileName
   ' Application.LoadFromText acMacro, strMacroName, strTemp

'4. delete the text file
    Kill strFileName
    
Exit_Handler:
    Exit Function
    
Err_Handler:
    If Err <> 2128 Then
      'create error message & log
      FormattedMsgBox "Error " & Err.Number & " in ModifyMacroVBA procedure : " & _
          "@" & Err.Description & "      @", vbCritical, "Error modifying macro"
     ' strProc = Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
    '  PopulateErrorLog
    End If
    Resume Exit_Handler

End Function



Public Function TestModifyMacroVBA()

    ModifyMacroVBA "mcrOpenMainMenuBKP", "MainMenu", "AdminMenu"
    
End Function

Function CloseAllVBEWindows() 'CR v5207

'closes all VBE windows except this one!
'requires library 'Microsoft Visual Basic for Applications Extensibility'

'CR 02/02/2016 - added error handling to fix issue in 64-bit Office

On Error GoTo Err_Handler

Dim vbWin As VBIDE.Window

For Each vbWin In Application.VBE.Windows
     If (vbWin.Type = vbext_wt_CodeWindow Or _
         vbWin.Type = vbext_wt_Designer) And _
         Not vbWin Is Application.VBE.ActiveWindow Then
             vbWin.Close
     End If
 Next
 
Exit_Handler:
    Exit Function

Err_Handler:
    If Err.Number = 424 Then Resume Next 'object required
    MsgBox "Error " & Err.Number & " in CloseAllVBEWindows procedure: " & Err.Description
    Resume Exit_Handler

End Function

Private Sub Command0_Click()

    Const p As String = "C:\macroedit\test.txt"
    Const mac As String = "macro1"

    Application.SaveAsText acMacro, mac, p
    
    s = CreateObject("scripting.filesystemobject").opentextfile(p, 1, False, -1).readall()
    
    If InStr(s, "form1") Then
        oldform = "form1"
        newform = "form2"
    Else
        oldform = "form2"
        newform = "form1"
    End If
    
    s = Replace(s, oldform, newform)
    
    CreateObject("scripting.filesystemobject").opentextfile(p, 2, False, -1).write s
    DoCmd.DeleteObject acMacro, mac
    RefreshDatabaseWindow
    
    Application.LoadFromText acMacro, mac, p
    RefreshDatabaseWindow
    
    DoCmd.RunMacro mac
End Sub

Public Function TestStaticCode2()

On Error GoTo Err_Handler

    Const P As String = "C:\Programs\MendipDataSystems\SDA\mcrOpenMainMenuBKP.txt"
    Const mac As String = "mcrOpenMainMenuBKP"

    'Dim S As Object
    Dim oldform As String
    Dim newform As String
    Application.SaveAsText acMacro, mac, P
    
    Dim objFSO As Object
    Dim objFile As Object
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    [COLOR="Red"]Set objFile = objFSO.opentextfile(P, 1, False, -1).readall()[/COLOR] 'Error 424 in this line
       
    'Set S = CreateObject("scripting.filesystemobject").opentextfile(P, 1, False, -1).readall()
    
    If InStr(objFile, "MainMenu") Then
        oldform = "MainMenu"
        newform = "AdminMenu"
    Else
        oldform = "AdminMenu"
        newform = "MainMenu"
    End If
    
    objFile = Replace(objFile, oldform, newform)
    
    CreateObject("scripting.filesystemobject").opentextfile(P, 2, False, -1).Write objFile
    DoCmd.DeleteObject acMacro, mac
    RefreshDatabaseWindow
    
    Application.LoadFromText acMacro, mac, P
    RefreshDatabaseWindow
    
    DoCmd.RunMacro mac
    
Err_Handler:
    MsgBox "Error " & Err.Number & " " & Err.Description
  '  On Error Resume Next
  '  Set objFile = Nothing
  '  Set objFSO = Nothing
  '  On Error GoTo 0
    
End Function

(P, 1, False, -1).readall()