VB6 - Modify VBA Macro Code From VB

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.

http://www.vbforums.com/attachment.p...postid=1846654

VB 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™

Hi there Rob,
I need to to show all the macros that a word document contains, so that a user can run the selected macro through my application. Fortunately found your post near morning :ehh:.

2 questions please:

1. I have got 2 macros as you can see here:
Line 1: Sub TestMacro()
Line 12: Sub Macro1()
Now, should I extract the macro name with some custom logic or is there any standard way to iterate through the macro collection?

2. Do you have any idea of the exception (between try-catch) ?

VB Code:

int nCount = m_appWord.VBE.ActiveVBProject.VBComponents.Count;
            richTextBox1.AppendText( "Project Count: " + nCount.ToString() );
            
            for(int i = 1; i <= nCount; i++)
            {
                m_appWord.VBE.ActiveVBProject.VBComponents.Item(i).Activate();
                                
                richTextBox1.AppendText( "\n------------------------------------------------------------------\n" );
                richTextBox1.AppendText( m_appWord.VBE.ActiveVBProject.VBComponents.Item(i).Name +
                    ": Type - " + m_appWord.VBE.ActiveVBProject.VBComponents.Item(i).Type );
                
                try
                {
                    richTextBox1.AppendText( " Line Count: " + m_appWord.VBE.ActiveVBProject.VBE.CodePanes.Item(i).CodeModule.CountOfLines);
 
                }catch(Exception ex)
                {
                    MessageBox.Show(this, ex.StackTrace, ex.Source + " " + ex.Message);
 
//System.Runtime.InteropServices.COMException (0x800A01C4): Exception from HRESULT: 0x800A01C4.
//at VBIDE.CodePanesClass.Item(Object index)
//at TestWord.Form1.btnListMacros_Click(Object sender, EventArgs e) in c:\documents and settings\administrator\desktop\mamjad dt\testword\form1.cs:line 663
//at System.Windows.Forms.Control.OnClick(EventArgs e)
//at System.Windows.Forms.Button.OnClick(EventArgs e)
//at System.Windows.Forms.Button.OnMouseUp(MouseEventArgs mevent)
//at System.Windows.Forms.Control.WmMouseUp(Message& m, MouseButtons button, Int32 clicks)
//at System.Windows.Forms.Control.WndProc(Message& m)
//at System.Windows.Forms.ButtonBase.WndProc(Message& m)
//at System.Windows.Forms.Button.WndProc(Message& m)
//at System.Windows.Forms.ControlNativeWindow.OnMessage(Message& m)
//at System.Windows.Forms.ControlNativeWindow.WndProc(Message& m)
//at System.Windows.Forms.NativeWindow.Callback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)
 
                }
 
                int nLineCount = m_appWord.VBE.ActiveVBProject.VBE.CodePanes.Item(i).CodeModule.CountOfLines;
                for(int nLine = 1; nLine <= nLineCount; nLine++)
                {
                    richTextBox1.AppendText( "\nLine " + nLine + ": " + m_appWord.VBE.ActiveVBProject.VBE.CodePanes.Item(i).CodeModule.get_Lines(nLine, 1) );
                }
 
                richTextBox1.AppendText( "\n" );
            }

HTML Code:

---

OUTPUT!!!
Project Count: 2
------------------------------------------------------------------
ThisDocument: Type - vbext_ct_Document Line Count: 23
Line 1: Sub TestMacro()
Line 2: '
Line 3: ' TestMacro Macro
Line 4: ' Macro recorded 1/20/2006 by Administrator
Line 5: '
Line 6:    Selection.TypeText Text:="Allah"
Line 7:    Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Line 8:    Selection.Font.Italic = wdToggle
Line 9:    Selection.Font.Bold = wdToggle
Line 10:    Selection.Font.Size = 36
Line 11: End Sub
Line 12: Sub Macro1()
Line 13: '
Line 14: ' Macro1 Macro
Line 15: ' Macro recorded 1/20/2006 by Administrator
Line 16: '
Line 17:    Selection.MoveRight Unit:=wdCharacter, Count:=1
Line 18:    Selection.TypeParagraph
Line 19:    Selection.TypeText Text:="o akbar"
Line 20:    Selection.MoveLeft Unit:=wdCharacter, Count:=5
Line 21:    Selection.TypeParagraph
Line 22:    Selection.MoveUp Unit:=wdLine, Count:=1
Line 23: End Sub

------------------------------------------------------------------
NewMacros: Type - vbext_ct_StdModule

---

Thanks a lot,
Muhammad Amjad

Welcome to the Forums.

I couldnt find anything on your C# Try Catch error but to list all procedures of a module I can do. Its the .ProcOfLine function that compares the lines and can return the type of procedure line it is (Property, Function, Sub, etc). No other way to count or retrieve them then to loop through all lines.