VB6 - Modify VBA Macro Code From VB

[RobDog888]

I wrote this for a member that needed to modify macro code that
referenced a server that was to be retired to another server's
name.

What it will do is basically open an Excel workbook and test for a
password on the vba project. Then it will loop through the
classes & modules looking through every line of code for the old
server name. Then it will replace the old server name with the
new server name and save the workbook and close it.

Access to Visual Basic Projects needs to be manually enabled for
this to work. So there is no threat of malicious action by this code.

Option Explicit
'Add reference to MS Excel xx.0 Object Library
'Trust Access to VB Projects needs to be enabled in Excel first.
'Check it, in Tools > Macros > Security > Trusted Publishers tab - "Trust access to Visual Basic projects"
Private moApp As Excel.Application
 
Private Sub Command1_Click()
    
    On Error GoTo No_Bugs
    
    Dim oWB As Excel.Workbook
    Dim i As Integer
    Dim iReplace As Integer
    Dim sReplace As String
    Dim sOriginalLine As String
    Dim iLine As Integer
    
    moApp.Visible = True
    'Do a loop here and iterate through your folder containing the workbooks.
    'ToDo: Start workbook loop of all folders and sub folders passing the workbook name
        Set oWB = moApp.Workbooks.Open("C:\Documents and Settings\VB-Guru\My Documents\Book2.xls")
        If moApp.VBE.ActiveVBProject.VBComponents.Item(1).Properties("HasPassword").Value = False Then
            If moApp.VBE.ActiveVBProject.VBComponents.Count > 0 Then 'Components are like sheet1,thisworkbook,etc.
                For i = 1 To moApp.VBE.ActiveVBProject.VBComponents.Count
                    moApp.VBE.ActiveVBProject.VBComponents.Item(i).Activate
                    Debug.Print "------------------------------------------------------------------"
                    Debug.Print moApp.VBE.ActiveVBProject.VBComponents.Item(i).Name & ": Type - " & moApp.VBE.ActiveVBProject.VBComponents.Item(i).Type
                    Debug.Print "Lines: " & moApp.VBE.ActiveVBProject.VBE.CodePanes.Item(i).CodeModule.CountOfLines
                    If moApp.VBE.ActiveVBProject.VBE.CodePanes.Item(i).CodeModule.CountOfLines > 0 Then
                        'Loop through all lines searching for "\\servername and replace with new server name"
                        For iLine = 1 To moApp.VBE.ActiveVBProject.VBE.CodePanes.Item(i).CodeModule.CountOfLines
                            Debug.Print "Line " & iLine & "  : " & moApp.VBE.ActiveVBProject.VBE.CodePanes.Item(i).CodeModule.Lines(iLine, 1)
                            iReplace = InStr(1, moApp.VBE.ActiveVBProject.VBE.CodePanes.Item(i).CodeModule.Lines(iLine, 1), "\\Server Name", vbTextCompare)
                            If iReplace > 0 Then
                                sOriginalLine = moApp.VBE.ActiveVBProject.VBE.CodePanes.Item(i).CodeModule.Lines(iLine, 1)
                                sReplace = Replace(sOriginalLine, "\\Server Name", "\\New Server", 1, 1, vbTextCompare)
                                moApp.VBE.ActiveVBProject.VBE.CodePanes.Item(i).CodeModule.ReplaceLine iLine, sReplace
                                Debug.Print "Repl " & iLine & "  : " & moApp.VBE.ActiveVBProject.VBE.CodePanes.Item(i).CodeModule.Lines(iLine, 1)
                            End If
                        Next
                    Else
                        Debug.Print moApp.VBE.ActiveVBProject.VBComponents.Item(i).Name & " contains No Macro code!"
                    End If
                Next
            Else
                Debug.Print oWB.FullName & " contains No VBComponents!!"
            End If
        End If
        oWB.Close True 'Save modifications to workbook
    'Loop
    Exit Sub
    
No_Bugs:
    If Err.Number = 50289 Then
        MsgBox oWB.Name & " contains a password on the VBProject!", vbOKOnly + vbExclamation
        Debug.Print oWB.FullName & " contains a password on the VBProject!"
    Else
        MsgBox Err.Number & " - " & Err.Description, vbOKOnly + vbExclamation
        Debug.Print "Other error" & vbNewLine & Err.Number & " - " & Err.Description
    End If
End Sub
 
Private Sub Form_Load()
    Set moApp = New Excel.Application
    moApp.Visible = False
End Sub
 
'MY SAMPLE OUTPUT!!!!
'------------------------------------------------------------------
'ThisWorkbook: Type - 100
'Lines: 3
'Line 1  : Public Sub Test()
'Line 2  :     MsgBox "Module Test"
'Line 3  : End Sub
'------------------------------------------------------------------
'Sheet1: Type - 100
'Lines: 0
'Sheet1 contains No Macro code!
'------------------------------------------------------------------
'Sheet2: Type - 100
'Lines: 0
'Sheet2 contains No Macro code!
'------------------------------------------------------------------
'Sheet3: Type - 100
'Lines: 0
'Sheet3 contains No Macro code!
'------------------------------------------------------------------
'Module1: Type - 1
'Lines: 5
'Line 1  : Private Sub Workbook_Open()
'Line 2  :     'MsgBox "\\Server Name\Test"
'Repl 2:       'MsgBox "\\New Server\Test"
'Line 3  : End Sub
'Line 4  :
'Line 5  :

VB/Excel Guru™