Building upon the success of a previous post: In MS Project how can I list all the sub routines along with their module names
I am using the code from http://www.cpearson.com/excel/vbe.aspx for Searching for text within a macro.
I am currently searching for some simple text however eventually I will be looping through a set of text (the sub and function names) and searching for them in each of the subs and functions in each module so that I can report back which macros and functions call other Subs and Functions.
The code is:
'.vbVisual Basic
'---------------------------------------------------------------------------------------
' Purpose : Prints all subs and functions in a project
' Prerequisites: Microsoft Visual Basic for Applications Extensibility 5.3 library
' CreateLogFile
' How to run: Run GetFunctionAndSubNames, set a parameter to blnWithParentInfo
' If ComponentTypeToString(vbext_ct_StdModule) = "Code Module" Then
'
' Used: ComponentTypeToString from -> http://www.cpearson.com/excel/vbe.aspx
'---------------------------------------------------------------------------------------
'taken from https://www.vitoshacademy.com/vba-listing-all-procedures-in-all-modules/
'slight modiications to display the module names and customise for MS Project rather than Excel
'changed CreateLogFile to Debug.print
'added choice of how to display the modules
Option Explicit
Private strSubsInfo As String
Public Sub X_GetFunctionAndSubNames()
Dim item As Variant
strSubsInfo = ""
Dim displaychoice As Integer
displaychoice = InputBox("How do you want to display the module names?:" & vbCrLf & "1 = In line with the Procedure Names, seperated by a ':'" & vbCrLf & "2 = The Module name: and then the Procedure names under the Module")
If Not (displaychoice = 1 Or displaychoice = 2) Then
MsgBox ("Only 1 or 2 can be chosen, the code will now exit")
Exit Sub
End If
For Each item In ThisProject.VBProject.VBComponents 'ThisWorkbook.VBProject.VBComponents
If ComponentTypeToString(vbext_ct_StdModule) = "Code Module" Then
ListProcedures item.Name, displaychoice, False
'Debug.Print item.CodeModule.Lines(1, item.CodeModule.CountOfLines)
End If
Next item
Debug.Print strSubsInfo
Chain_slack.Clipboard (strSubsInfo)
MsgBox ("The procedure and module names have been printed to the Immediate window and has been saved to the Clipboard")
'CreateLogFile strSubsInfo
End Sub
Private Sub ListProcedures(strName As String, displaychoice As Integer, Optional blnWithParentInfo = False)
'Microsoft Visual Basic for Applications Extensibility 5.3 library is needed for this to run.
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Dim ProcName As String
Dim ModuleName As String
Dim ProcKind As VBIDE.vbext_ProcKind
Dim Start_row As Long
Dim End_row As Long
Dim FindThis As String
Set VBProj = ThisProject.VBProject 'ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(strName)
Set CodeMod = VBComp.CodeModule
ModuleName = VBComp.CodeModule.Name
FindThis = "find this here"
If displaychoice = 2 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & "Module - " & ModuleName
With CodeMod
LineNum = .CountOfDeclarationLines + 1
Do Until LineNum >= .CountOfLines
ProcName = .ProcOfLine(LineNum, ProcKind)
Start_row = LineNum
End_row = Start_row + .ProcCountLines(ProcName, ProcKind) + 1
If blnWithParentInfo Then
If displaychoice = 2 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & strName & "." & ProcName
If displaychoice = 1 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & strName & "." & ProcName & " : " & ModuleName
Else
If displaychoice = 2 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & ProcName
If displaychoice = 1 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & ProcName & " : " & ModuleName
End If
LineNum = .ProcStartLine(ProcName, ProcKind) + .ProcCountLines(ProcName, ProcKind) + 1
'within this loop can I use the search sub (turned into a functon) from http://www.cpearson.com/excel/vbe.aspx to look from the start line to the end line of this proc
'and loop thorugh an array or string (easier to transfer fom the starting function?) to see if the proc contains any of the names in the string/array?
'start with a simple term which has been seeded through the project in known places before starting to loop through the various search terms
If SearchCodeModule(ModuleName, Start_row, End_row, FindThis) = True Then Debug.Print ModuleName & ": " & ProcName & " contains " & FindThis & " " & Start_row & "-" & End_row
Loop
End With
End Sub
Function ComponentTypeToString(ComponentType As VBIDE.vbext_ComponentType) As String
'ComponentTypeToString from http://www.cpearson.com/excel/vbe.aspx
Select Case ComponentType
Case vbext_ct_ActiveXDesigner
ComponentTypeToString = "ActiveX Designer"
Case vbext_ct_ClassModule
ComponentTypeToString = "Class Module"
Case vbext_ct_Document
ComponentTypeToString = "Document Module"
Case vbext_ct_MSForm
ComponentTypeToString = "UserForm"
Case vbext_ct_StdModule
ComponentTypeToString = "Code Module"
Case Else
ComponentTypeToString = "Unknown Type: " & CStr(ComponentType)
End Select
End Function
Function SearchCodeModule(module_name As String, SL As Long, EL As Long, FindWhat As String)
'from http://www.cpearson.com/excel/vbe.aspx
'should be returning a true or false
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
'Dim FindWhat As String
'Dim SL As Long ' start line
'Dim EL As Long ' end line
Dim SC As Long ' start column
Dim EC As Long ' end column
Dim Found As Boolean
Set VBProj = ThisProject.VBProject
Set VBComp = VBProj.VBComponents(module_name)
Set CodeMod = VBComp.CodeModule
'FindWhat = "findthis"
With CodeMod
'SL = 1
'EL = .CountOfLines
SC = 1
EC = 255
Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _
EndLine:=EL, EndColumn:=EC, _
wholeword:=True, MatchCase:=False, patternsearch:=False)
'Do Until Found = False
' Debug.Print "Found at: Line: " & CStr(SL) & " Column: " & CStr(SC)
' EL = .CountOfLines
' SC = EC + 1
' EC = 255
' Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _
' EndLine:=EL, EndColumn:=EC, _
' wholeword:=True, MatchCase:=False, patternsearch:=False)
'Loop
End With 'why are SL and EL set to equal the location of the string and also the values for StartLine and EndLine are set to the same; how can I keep these for the next loop?
SearchCodeModule = Found 'Debug.Print Found
End Function
At the point it enters the loop in Sub ListProcedures the start and finish of the row for the current procedure is noted in Start_row and End_row. These values are passsed to the Seach function to limit the search area within each Module. The issue is that when the Search function finds a match (i.e. Found = True) the values for SL, EL, Start_Row and End_row all become the row at which the searched for text is found. This is an issue as in the future when I am looping through all the possible search strings I will need Start_row and End_row to stay the same. Why is it doing this and how to I fix it? :) Many thanks for helping my continued education.
Public Sub X_GetFunctionAndSubNames()
Dim vbProj As VBIDE.VBProject
Set vbProj = ThisProject.VBProject
Dim Item As VBIDE.VBComponent
For Each Item In vbProj.VBComponents
If Item.Type = vbext_ct_StdModule Then
Dim SubsInfo As String
SubsInfo = SubsInfo & vbCrLf & ListProcedures(vbProj, Item)
End If
Next Item
Debug.Print SubsInfo
'Chain_slack.Clipboard (SubsInfo)
MsgBox "The procedure and module names have been printed to the Immediate window and has been saved to the Clipboard"
End Sub
Function ListProcedures(vbProj As VBIDE.VBProject, module As VBIDE.VBComponent) As String
Dim modInfo As String
modInfo = module.Name
Dim ProcKind As VBIDE.vbext_ProcKind
ProcKind = vbext_pk_Proc
With module.CodeModule
Dim LineNum As Long
LineNum = .CountOfDeclarationLines + 1
Do Until LineNum >= .CountOfLines
Dim procName As String
procName = .ProcOfLine(LineNum, ProcKind)
modInfo = modInfo & vbCrLf & vbTab & procName & FindCalls(vbProj, procName)
LineNum = .ProcStartLine(procName, ProcKind) + .ProcCountLines(procName, ProcKind) + 1
Loop
End With
ListProcedures = modInfo
End Function
Function FindCalls(vbProj As VBIDE.VBProject, procName As String) As String
Dim VBComp As VBIDE.VBComponent
For Each VBComp In vbProj.VBComponents
If VBComp.Type = vbext_ct_StdModule Then
With VBComp.CodeModule
Dim callInfo As String
Dim SL As Long
SL = 0
Do Until Not .Find(procName, SL, 0, .CountOfLines, 0, WholeWord:=True)
Dim foundIn As String
foundIn = .ProcOfLine(SL, vbext_pk_Proc)
If procName <> foundIn And Len(foundIn) > 0 Then
callInfo = callInfo & vbCrLf & vbTab & vbTab & "called by " & foundIn & " on line " & SL
End If
SL = SL + 1
Loop
End With
End If
Next VBComp
FindCalls = callInfo
End Function
Procedure names are shown indented below the module name and then indented under that is the list of where they are called.
BuildVBAModel
X_GetFunctionAndSubNames
ListProcedures
called by X_GetFunctionAndSubNames on line 14
FindCalls
called by ListProcedures on line 42
Module2
MainProc
Func1
called by MainProc on line 6
called by MainProc on line 11
ProcB
called by MainProc on line 8
called by MainProc on line 13