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.

http://www.vbforums.com/attachment.php?s=&postid=1846654

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™

[MuhammadAmjadIqbal]

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) ?


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" );
}


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

[RobDog888]

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.