Solved: VBComponents - how to retrieve "Sub" or "Function" exactly

[IBihy]

Hello all,

I'm using Excel 2003, and my reporting application is in wrap-up for distribution. In order to estimate my remaining efforts, I created a worksheet "ModuleList" and the macro ListModules does it's work. However, via "VBIDE.vbext_ProcKind" I get only "Sub or Function". I would like to get "Sub" if it is a sub, "Function" if it is a function.
In fact I need the very first line, like
(Public/Private) Function DoSomethingAndReturnValue(InputA as String) As Long OR
(Public/Private) Sub DoSomething(InputA As String)

It' not exactly a show-stopper but it would be nifty to have it.

Thanks for having a look. Code is below.
Isabella
[vba]
Sub ListModules()
Dim boolIsSub As Boolean
Dim boolHasComment As Boolean
Dim EL As Long
Dim LineNum As Long
Dim NumLines As Long
Dim strCompType As String
Dim ProcName As String
Dim FindSub As String
Dim FindComment As String
Dim VBProj As Object
Dim VBEPart As Object
Dim WS As Worksheet
Dim Rng As Range
Dim aCodeMod As VBIDE.CodeModule
Dim ProcKind As VBIDE.vbext_ProcKind

Set collVBParts = New Collection

Set VBEPart = Application.VBE.ActiveVBProject.VBComponents
Set VBProj = ActiveWorkbook.VBProject
Set WS = ActiveWorkbook.Worksheets("ModuleList")
Set Rng = WS.Range("A3")

'WS.Range("A3").CurrentRegion.Clear

FindSub = "Sub"
FindComment = "'* Module: *"
'Dim myMod As Object
'Set myMod = VBProj.VBComponents("DataSources")


For Each VBEPart In VBProj.VBComponents
strCompType = ComponentTypeToString(VBEPart.Type)
If strCompType = "UserForm" Or strCompType = "Code Module" Then
Set aCodeMod = VBEPart.CodeModule
Rng(1, 4).Value = VBEPart.Name
Rng(1, 5).Value = ComponentTypeToString(VBEPart.Type)
With aCodeMod
LineNum = .CountOfDeclarationLines + 1
EL = .CountOfLines
Do Until LineNum >= .CountOfLines
ProcName = .ProcOfLine(LineNum, ProcKind)
Rng.Value = ProcName
GoSub GetDetails
LineNum = .ProcStartLine(ProcName, ProcKind) + _
.ProcCountLines(ProcName, ProcKind) + 1
Set Rng = Rng(2, 1)
Loop
End With
Set Rng = Rng(2, 1)
Else
GoTo ContinueSearch
End If
ContinueSearch:
Next VBEPart
Exit Sub
GetDetails:
boolIsSub = aCodeMod.Find(target:=FindSub, StartLine:=1, StartColumn:=1, _
EndLine:=EL, EndColumn:=20, _
wholeword:=True, MatchCase:=False, Patternsearch:=False)
If boolIsSub = True Then
'Debug.Print ProcName + " is Sub"
Rng(1, 2).Value = "Sub"
Else
'Debug.Print ProcName + " is Function"
Rng(1, 2).Value = "Function"
End If
boolHasComment = aCodeMod.Find(target:=FindComment, StartLine:=1, StartColumn:=1, _
EndLine:=EL, EndColumn:=20, _
wholeword:=True, MatchCase:=False, Patternsearch:=False)
If boolHasComment = True Then
'Debug.Print ProcName + " has Comment"
Rng(1, 3).Value = "has Comment"
Else
'Debug.Print ProcName + " Comment is missing"
Rng(1, 3).Value = "Comment is missing"
End If
boolIsSub = False
boolHasComment = False
Return
End Sub
Function ComponentTypeToString(ComponentType As VBIDE.vbext_ComponentType) As String

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 ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
Select Case ProcKind
Case vbext_pk_Get
ProcKindString = "Property Get"
Case vbext_pk_Let
ProcKindString = "Property Let"
Case vbext_pk_Set
ProcKindString = "Property Set"
Case vbext_pk_Proc
ProcKindString = "Sub Or Function"
Case Else
ProcKindString = "Unknown Type: " & CStr(ProcKind)
End Select
End Function[/vba]

[Dave]

[VBA]
Dim Rng As Range
Set Rng = WS.Range("A3")
Rng(1, 4).Value =
[/VBA]
This looks wrong. Rng is a range not an array. It also should be...
[VBA]
WS.Rng = something
[/VBA] HTH. Dave

[IBihy]

Hello Dave,
that code Set Rng = WS.Range("A3") works fine. Rng(1, 4) is relative addressing, first row in that range, column 4.
I'd like to get the first line of each sub or function.

Nope, not quite the point, but thanks for the respone.
Regards,
Isabella

[mancubus]

try:

[VBA]Cells(1, 4)[/VBA]

[IBihy]

Hello folks,

thanks for your responses so far. But they are completely missing the point. The "weird" syntax of "Rng(1, 4).Value = ..." and similar is the output on the worksheet. I do get output on my worksheet. I agree that coding like this is shorthand rather than the fully written out 100% correct code, e.g. "Rng.Cells(1, 4).Value = ..."

It's not the question, though.

Even if I repeat myself: I would like to get exactly "Sub" if the part in a module is a sub, of "Function" is it is a function.

But, if it cools off the discussion about the shorthand syntax, I'm adding the "corrected" code below.

If you like, n order to try it out yourself, in the Excel VBEditor, you need to go to Tools --> References and check the box at "Microsoft Visual Basic for Applications Extensibility ...", Copy the code in a module of a workbook that has modules and or user forms (my code excludes class modules, because my code doesn't have any). in your workbook, create a worksheet "ModuleList", add headlines in cells A1 through E1:
Procedure Name (A1), Type (B1), Comment? (C1), Module Name (D1), Module Type (E1). Then start "ListModules".

Regards,
Isabella


[VBA]Sub ListModules()
Dim boolIsSub As Boolean
Dim boolHasComment As Boolean
Dim lngCtLines As Long
Dim lngLineNbr As Long
Dim lngAmtLines As Long
Dim strCompType As String
Dim strProcName As String
Dim strFindSub As String
Dim strFindComment As String
Dim VBProj As Object
Dim VBEPart As Object
Dim WS As Worksheet
Dim rngOutputRow As Range
Dim aCodeMod As CodeModule
Dim ProcKind As VBIDE.vbext_ProcKind

Set VBEPart = Application.VBE.ActiveVBProject.VBComponents
Set VBProj = ActiveWorkbook.VBProject
Set WS = ActiveWorkbook.Worksheets("ModuleList")
Set rngOutputRow = WS.Range("A3")

' rngOutputRow.CurrentRegion.Select

strFindSub = "Sub"
strFindComment = "'* Module: *"

For Each VBEPart In VBProj.VBComponents
strCompType = ComponentTypeToString(VBEPart.Type)
If strCompType = "UserForm" Or strCompType = "Code Module" Then
Set aCodeMod = VBEPart.CodeModule
rngOutputRow.Cells(1, 4).Value = VBEPart.Name
rngOutputRow.Cells(1, 5).Value = ComponentTypeToString(VBEPart.Type)
With aCodeMod
lngLineNbr = .CountOfDeclarationLines + 1
lngCtLines = .CountOfLines
Do Until lngLineNbr >= .CountOfLines
strProcName = .ProcOfLine(lngLineNbr, ProcKind)
rngOutputRow.Value = strProcName
GoSub GetDetails
lngLineNbr = .ProcStartLine(strProcName, ProcKind) + _
.ProcCountLines(strProcName, ProcKind) + 1
Set rngOutputRow = rngOutputRow(2, 1)
Loop
End With
Set rngOutputRow = rngOutputRow.Cells(2, 1)
Else
GoTo ContinueSearch
End If
ContinueSearch:
Next VBEPart
Exit Sub
GetDetails:
boolIsSub = aCodeMod.Find(target:=strFindSub, StartLine:=1, StartColumn:=1, _
EndLine:=lngCtLines, EndColumn:=20, _
wholeword:=True, MatchCase:=False, Patternsearch:=False)
If boolIsSub = True Then
'Debug.Print strProcName + " is Sub"
rngOutputRow.Cells(1, 2).Value = "Sub"
Else
'Debug.Print strProcName + " is Function"
rngOutputRow.Cells(1, 2).Value = "Function"
End If
boolHasComment = aCodeMod.Find(target:=strFindComment, StartLine:=1, StartColumn:=1, _
EndLine:=lngCtLines, EndColumn:=20, _
wholeword:=True, MatchCase:=False, Patternsearch:=False)
If boolHasComment = True Then
'Debug.Print strProcName + " has Comment"
rngOutputRow.Cells(1, 3).Value = "has Comment"
Else
'Debug.Print strProcName + " Comment is missing"
rngOutputRow.Cells(1, 3).Value = "Comment is missing"
End If
boolIsSub = False
boolHasComment = False
Return
End Sub
Function ComponentTypeToString(ComponentType As VBIDE.vbext_ComponentType) As String

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 ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
Select Case ProcKind
Case vbext_pk_Get
ProcKindString = "Property Get"
Case vbext_pk_Let
ProcKindString = "Property Let"
Case vbext_pk_Set
ProcKindString = "Property Set"
Case vbext_pk_Proc
ProcKindString = "Sub Or Function"
Case Else
ProcKindString = "Unknown Type: " & CStr(ProcKind)
End Select
End Function[/VBA]

[Dave]

Isabella... I'm guessing that you haven't resolved this yet? It is some very useful code. It is likely that others are having trouble responding. I believe the code will only work for XP and XL 2003 (and earlier)...I may be wrong with this. Also, it is difficult code to follow without comments and it is somewhat spagettied. I put a bit of time into trialing it. Columm B does identify functions if no sub is present. This leads me to believe that this part of the code is wrong...
[VBA]boolIsSub = aCodeMod.Find(target:=strFindSub, StartLine:=1, StartColumn:=1, _
EndLine:=lngCtLines, EndColumn:=20, _
wholeword:=True, MatchCase:=False, Patternsearch:=False)[/VBA]
The LngCtLines is wrong... the find looks @ the whole module and
if "SUB" is present anywhere in the module then the result is True
and "SUB" is placed in Column B. Trial having only functions in a module
and then adding/removing a sub. The startline value of the find and endline
needs to represent the module line that the sub/function is on... not the whole
module. This is also likely the problem with the comment section. I'm guessing to
make the whole thing more functional for Vista, 07
and XL versions beyond 2003, that the modules need to be exported to Word and the
and then withdraw the info from there. I understand your frustration with the rng
suggestions before but sometimes it's the simple things. HTH. Dave

[IBihy]

Hi Dave,
thanks for responding. You guessed it, I still use XP Professional and Excel 2003.
Yes, you may have a point here, lngCtLines looks at the complete VBEPart, which is a code module, in fact. And all of may code modules contain more than one sub or function.
Jeez, I'm fairly new to the forum and I'm posting such a whopper ...
While writing this, something dawns upon me...
Yes, yes, I think I need to re-set lngCtLines after each sub or function. Let me try this and I'll post again.
I wasn't frustrated, really, rather surprised. I thought I had expressed myself clearly, but then I didn't. It's a discussion place here, and ... (this is one of my favorite lines)... There are no stupid questions, but lots of silly answers.
Regards,
Isabella

[IBihy]

Hello Dave,

Thanks very much for the hint, the problem was rather in the parameter "Startline". BTW, the find method stops searching after the first hit. Searching for "Sub" or "Function" now works with this code:
[VBA]GetDetails:
boolIsSub = aCodeMod.Find(Target:=strFindSub, StartLine:=aCodeMod.ProcStartLine(strProcName, ProcKind), _
StartColumn:=1, EndLine:=lngLineNbr, EndColumn:=20, _
Wholeword:=True, MatchCase:=False, Patternsearch:=False)
[/VBA]
Now I'll have to persuade it to do the same for the comments.

Whoopeee!
Greetings, Isabella

[IBihy]

Hello,

with special thanks to Dave, whose hints helped me find the solution. This works like a charm. Below is the code:
[VBA]Sub ListModules()
Dim boolIsSub As Boolean
Dim boolHasComment As Boolean
Dim lngCtLines As Long
Dim lngLineNbr As Long
Dim lngAmtLines As Long
Dim strCompType As String
Dim strProcName As String
Dim strFindSub As String
Dim strFindComment As String
Dim VBProj As Object
Dim VBEPart As Object
Dim WS As Worksheet
Dim rngOutputRow As Range
Dim aCodeMod As CodeModule
Dim ProcKind As VBIDE.vbext_ProcKind

Set VBEPart = Application.VBE.ActiveVBProject.VBComponents
Set VBProj = ActiveWorkbook.VBProject
Set WS = ActiveWorkbook.Worksheets("ModuleList")
Set rngOutputRow = WS.Range("A3")

strFindSub = "Sub"
strFindComment = "'* Module: *"

For Each VBEPart In VBProj.VBComponents
strCompType = ComponentTypeToString(VBEPart.Type)
If strCompType = "UserForm" Or strCompType = "Code Module" Then
Set aCodeMod = VBEPart.CodeModule
rngOutputRow.Cells(1, 4).Value = VBEPart.Name
rngOutputRow.Cells(1, 5).Value = ComponentTypeToString(VBEPart.Type)
With aCodeMod
lngLineNbr = .CountOfDeclarationLines + 1
lngCtLines = .CountOfLines
Do Until lngLineNbr >= .CountOfLines
strProcName = .ProcOfLine(lngLineNbr, ProcKind)
rngOutputRow.Cells(1, 1).Value = strProcName
GoSub GetDetails
lngLineNbr = .ProcStartLine(strProcName, ProcKind) + _
.ProcCountLines(strProcName, ProcKind) + 1
Set rngOutputRow = rngOutputRow.Cells(2, 1)
Loop
End With
Set rngOutputRow = rngOutputRow.Cells(2, 1)
Else
GoTo ContinueSearch
End If
ContinueSearch:
Next VBEPart
Exit Sub
GetDetails:
boolIsSub = aCodeMod.Find(Target:=strFindSub, StartLine:=aCodeMod.ProcStartLine(strProcName, ProcKind), _
StartColumn:=1, EndLine:=lngLineNbr, EndColumn:=20, _
Wholeword:=True, MatchCase:=False, Patternsearch:=False)
If boolIsSub = True Then
'Debug.Print strProcName + " is Sub"
rngOutputRow.Cells(1, 2).Value = "Sub"
Else
'Debug.Print strProcName + " is Function"
rngOutputRow.Cells(1, 2).Value = "Function"
End If
boolHasComment = aCodeMod.Find(Target:=strFindComment, StartLine:=aCodeMod.ProcStartLine(strProcName, ProcKind), _
StartColumn:=1, EndLine:=(aCodeMod.ProcStartLine(strProcName, ProcKind) + 5), _
EndColumn:=20, Wholeword:=True, MatchCase:=False, Patternsearch:=False)
If boolHasComment = True Then
'Debug.Print strProcName + " has Comment"
rngOutputRow.Cells(1, 3).Value = "has Comment"
Else
'Debug.Print strProcName + " Comment is missing"
rngOutputRow.Cells(1, 3).Value = "Comment is missing"
End If
boolIsSub = False
boolHasComment = False
Return
End Sub
Function ComponentTypeToString(ComponentType As VBIDE.vbext_ComponentType) As String

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 ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
Select Case ProcKind
Case vbext_pk_Get
ProcKindString = "Property Get"
Case vbext_pk_Let
ProcKindString = "Property Let"
Case vbext_pk_Set
ProcKindString = "Property Set"
Case vbext_pk_Proc
ProcKindString = "Sub Or Function"
Case Else
ProcKindString = "Unknown Type: " & CStr(ProcKind)
End Select
End Function[/VBA]

Thanks again,
Have a nice day,
Isabella

[Bob Phillips]

If you declare a Property, this code treats it as a Function, so it needs a slight mod.

[Bob Phillips]

In fact, it also seems to ignore properties completely in a class module.

[IBihy]

Hi xld,
you're right in both cases. The code I placed in the forum ignores Class modules, 'cause there aren't any. Therefore I'm not looking for "property".

Yes, for a general solution that would need to be integrated.

Greetings,
Isabella

[Bob Phillips]

you can have properties in non-class modules, that was my point in the first of my postings.

[Bob Phillips]

Anyway, Userforms, Worksheets, Workbook, they are all class modules.

[IBihy]

Yes, 'cause they're all objects in Excel.