Listing Names of Subs & Functions

**johnske** · 10-29-2004, 03:41 AM

Hi,
I want to create a "Library"/directory of VB code. But I'm stuck on two points (I dont know if there's already a tool for doing this so I've started to make one of my own)

The code below returns all the VB components in the active workbook. This is fine if all the modules have been named after the procedure contained in it, but it's not always practical as a single module may contain several other private or public subs or functions - one of which might be the one I'm looking for (on top of which, some modules may just be named "module1" or 2) so I really need something that returns all the individual subs in each module as well - Any suggestions?

Ideally, instead of just the active workbook, I should also be able to get a list (and the path of course) of the subs in all workbooks...but how do I access those books without opening them all and causing a memory overflow?

'This lists all VB components in a 3 column list box

Private Sub UserForm_activate()
Dim N As Integer, MyList(100, 3) 'as array type
'//headings
MyList(0, 0) = "COMPONENT NAME"
MyList(0, 1) = "COMPONENT TYPE"
MyList(0, 2) = "BOOK NAME"
'//define list
For N = 1 To ActiveWorkbook.VBProject.VBcomponents.Count
MyList(N, 0) = ActiveWorkbook.VBProject.VBcomponents(N).Name
MyList(N, 1) = ActiveWorkbook.VBProject.VBcomponents(N).Type
MyList(N, 2) = ActiveWorkbook.Name
'//change type from a number to a name
If MyList(N, 1) = 1 Then MyList(N, 1) = "Basic Module"
If MyList(N, 1) = 2 Then MyList(N, 1) = "Class Module"
If MyList(N, 1) = 3 Then MyList(N, 1) = "UserForm"
If MyList(N, 1) = 100 Then MyList(N, 1) = "Book/Sheet Class Module)"
Next N
'//load list to listbox
ListBox1.List = MyList
End Sub

'This is optional - used if a 'hard copy' list of components is wanted

Private Sub CommandButton1_Click()
Dim N As Integer
'//add a new work sheet
Application.ScreenUpdating = False
ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
'//add headings to the sheet
Range("A1") = "COMPONENT NAME"
Range("B1") = "COMPONENT TYPE"
Range("C1") = "BOOK NAME"
'//add list to the sheet
For N = 1 To ActiveWorkbook.VBProject.VBcomponents.Count
Range("A" & N + 1) = ActiveWorkbook.VBProject.VBcomponents(N).Name
Range("B" & N + 1) = ActiveWorkbook.VBProject.VBcomponents(N).Type
Range("C" & N + 1) = ActiveWorkbook.Name
'//change type from a number to a name
If Range("B" & N + 1) = 1 Then Range("B" & N + 1) = "Basic Module"
If Range("B" & N + 1) = 2 Then Range("B" & N + 1) = "Class Module"
If Range("B" & N + 1) = 3 Then Range("B" & N + 1) = "UserForm"
If Range("B" & N + 1) = 100 Then Range("B" & N + 1) = "Book/Sheet Class Module)"
Next N
ActiveSheet.Columns("A:C").EntireColumn.AutoFit
Unload Me
End Sub

**Richie(UK)** · 10-29-2004, 06:35 AM

Hi John,

Is this the sort of thing that you mean?

Sub Test()
    Dim wbk As Workbook
    Dim VBComp As VBComponent
    Dim Msg As String
Set wbk = ThisWorkbook
For Each VBComp In wbk.VBProject.VBComponents
        Msg = Msg & ListProcedures(wbk, VBComp.Name)
    Next VBComp
    MsgBox Msg
End Sub

Function ListProcedures(wbk As Workbook, strModName As String) As String
'add a reference to VBA Extensibility library
    Dim VBCodeMod As CodeModule
    Dim StartLine As Long
    Dim strTemp As String
Set VBCodeMod = wbk.VBProject.VBComponents(strModName).CodeModule
    With VBCodeMod
        StartLine = .CountOfDeclarationLines + 1
        Do Until StartLine >= .CountOfLines
            strTemp = strTemp & .ProcOfLine(StartLine, vbext_pk_Proc) & vbNewLine
            StartLine = StartLine + _
              .ProcCountLines(.ProcOfLine(StartLine, vbext_pk_Proc), vbext_pk_Proc)
        Loop
    End With
    ListProcedures = strTemp
End Function

A nice reference for this sort of thing is Chip Pearson's page here:
http://www.cpearson.com/excel/vbe.htm

HTH

**Zack Barresse** · 10-29-2004, 09:09 AM

Matt, that's a slick rendition.

I'll find that very useful.

Nice job fellas!

**Ken Puls** · 10-29-2004, 10:27 AM

Hi there,

mvidas, don't know if this will help, but just recorded this:

Application.MacroOptions Macro:="PERSONAL.XLS!Macro1", Description:="", _
        ShortcutKey:="B"

Was thinking you could maybe loop and compare macro names to macro options...

Cheers,

**Zack Barresse** · 10-29-2004, 11:22 AM

Hey Matt,

This seems to work for me to go through all open workbooks. This will take into account any hidden sheets e.g. Personal.xls ...

Sub ShowAllModules()
    Application.ScreenUpdating = False
    Dim N As Integer, i As Long, T As Integer
    Dim VBC As VBComponent, sTmp As String, wb As Workbook
    Dim myBook As Workbook, mySheet As Worksheet, currBook As Workbook
    Set currBook = ActiveWorkbook
    If ActiveWorkbook Is Nothing Then
        Workbooks.Add
        Set myBook = ActiveWorkbook
        Set mySheet = myBook.ActiveSheet
    Else
        Sheets.Add after:=Sheets(Sheets.Count)
        Set myBook = ActiveWorkbook
        Set mySheet = myBook.ActiveSheet
    End If
    mySheet.Range("A1") = "COMPONENT NAME"
    mySheet.Range("B1") = "COMPONENT TYPE"
    mySheet.Range("C1") = "BOOK NAME"
    mySheet.Range("D1") = "PROCEDURES"
    N = 2
    For Each wb In oExcel.Workbooks
        wb.Activate
        For Each VBC In ActiveWorkbook.VBProject.VBComponents
            mySheet.Range("A" & N) = VBC.name
            T = VBC.Type
            If T = 1 Then mySheet.Range("B" & N) = "Basic Module"
            If T = 2 Then mySheet.Range("B" & N) = "Class Module"
            If T = 3 Then mySheet.Range("B" & N) = "UserForm"
            If T = 11 Then mySheet.Range("B" & N) = "ActiveX"
            If T = 100 Then mySheet.Range("B" & N) = "Book/Sheet Class Module"
            mySheet.Range("C" & N) = ActiveWorkbook.name
            With VBC.CodeModule
                i = .CountOfDeclarationLines + 1
                sTmp = ""
                Do Until i >= .CountOfLines
                    mySheet.Range("D" & N) = .ProcOfLine(i, vbext_pk_Proc)
                    i = i + .ProcCountLines(.ProcOfLine(i, vbext_pk_Proc), vbext_pk_Proc)
                    If i < .CountOfLines Then N = N + 1
                Loop
            End With
            N = N + 1
        Next
    Next wb
    mySheet.Columns.AutoFit
    currBook.Activate
    Application.ScreenUpdating = True
End Sub

You know what would be really cool? Is to show (on top of something like this) all subs/procedures in all installed add-ins also. Now THAT would be something useful.

**Ken Puls** · 10-29-2004, 12:25 PM

Just an FYI, I have something that I was working on a while ago as well. I'll try and throw it up later (just for comparison) later tonight. (Too busy at work today)

It's a userform which, when completed, could be used to copy a routine from one workbook to another (without entering the VBE). It does search all add-ins, and returns a list of all procedures in there... at least for non-password protected ones. The code to copy the actual code isn't there, but the rest is.

Cheers,

**Richie(UK)** · 10-29-2004, 01:04 PM

Hi all,

Ivan F Moala has an Add-in that will list Short-Cut keys:
http://www.xcelfiles.com/GetShortCutKeys.html

As regards the main requirement, my second attempt:[vba]Public Const strWsName As String = "CodeSummary"

Sub Main()
    Dim wsSummary As Worksheet
On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets(strWsName).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
Application.ScreenUpdating = False
    Set wsSummary = ThisWorkbook.Worksheets.Add
With wsSummary
        .Name = strWsName
        .Range("A1").Resize(1, 4) = _
            Array("Workbook Name", "Component Name", _
            "Component Type", "Procedure Name")
        Call OpenAndProcess
        .Columns("A:D").EntireColumn.AutoFit
    End With
    Sheet1.Select
    Application.ScreenUpdating = True
frmShowCode.Show
End Sub

Sub OpenAndProcess()
    Dim vaFileName As Variant
    Const MyDir As String = _
        "C:\Documents and Settings\Richie\My Documents\Excel\Tests"
    'change as required
With Application.FileSearch
        .NewSearch
        .LookIn = MyDir
        .SearchSubFolders = False
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute > 0 Then
            Application.ScreenUpdating = False
            For Each vaFileName In .FoundFiles
                ListEm (vaFileName)
            Next
        Else
            MsgBox "There were no Excel files found."
        End If
        Application.ScreenUpdating = True
    End With
End Sub

Sub ListEm(ByVal Fname As String)
    Dim wbk As Workbook
    Dim wsSummary As Worksheet
    Dim VBComp As VBComponent, VBCodeMod As CodeModule
    Dim StartLine As Long, Msg As String, lRow As Long
Set wbk = Workbooks.Open(Filename:=Fname)
    Set wsSummary = ThisWorkbook.Worksheets(strWsName)
lRow = wsSummary.Cells(Rows.Count, 1).End(xlUp).Row
For Each VBComp In wbk.VBProject.VBComponents
        Set VBCodeMod = VBComp.CodeModule
        With VBCodeMod
            StartLine = .CountOfDeclarationLines + 1
            Do Until StartLine >= .CountOfLines
                Msg = .ProcOfLine(StartLine, vbext_pk_Proc)
                lRow = lRow + 1
                wsSummary.Cells(lRow, 1).Resize(1, 4) = _
                    Array(wbk.Name, VBComp.Name, CompTypeToName(VBComp), Msg)
                StartLine = StartLine + .ProcCountLines _
                    (.ProcOfLine(StartLine, vbext_pk_Proc), vbext_pk_Proc)
            Loop
        End With
    Next VBComp
wbk.Close savechanges:=True
End Sub

Function CompTypeToName(VBComp As VBComponent) As String
    Select Case VBComp.Type
        Case vbext_ct_ActiveXDesigner
            CompTypeToName = "ActiveX Designer"
        Case vbext_ct_ClassModule
            CompTypeToName = "Class Module      "
        Case vbext_ct_Document
            CompTypeToName = "Document           "
        Case vbext_ct_MSForm
            CompTypeToName = "MS Form              "
        Case vbext_ct_StdModule
            CompTypeToName = "Standard Module"
        Case Else
    End Select
End Function

And in the Userform:

Private Sub UserForm_Initialize()
    Dim MyList As Variant
MyList = ThisWorkbook.Worksheets(strWsName).UsedRange.Value
With Me.ListBox1
        .ColumnCount = 4
        .List = MyList
    End With
End Sub

HTH

**Ken Puls** · 10-29-2004, 02:46 PM

Originally Posted by firefytr

You know what would be really cool? Is to show (on top of something like this) all subs/procedures in all installed add-ins also. Now THAT would be something useful.

Hey Zack,

The following will return you the collection, and could be incorporated into anything here:

Dim wb As AddIn
For Each wb In Application.AddIns
Debug.Print wb.Name
Next wb

The kicker is though, when I used it with my file (attached), I got a list of all my addins, but most were password protected, so I couldn't access them.

On the rest of the thread...

Regarding the file attached, as mentioned before, I set this up with intentions of making it a code copier. Something easy for use in setting up a new workbook with pre loaded procs. It isn't completely finished (I never did get to writing the code to actually copy the procedures,) but it does collect all procedures in any given module, userform, etc. and ask you where you want to put them. (If you go all the way to finish, it will even tell you what was selected.

Checkboxes are on the userform to filter in/out certain classes of modules.

In order to bypass the addin protection issue, I set up a list of addins that I can access on a defaults page, in addition to some default settings for the checkbox.

At any rate... I'm hoping to finish it at some point, but maybe there's some code in here that someone finds useful.

(This is more to the procedure listing side, rather than getting things from all files as Johnske is looking for though.... could be a base, maybe, or just an idea farm...)

Cheers,

Thread: Listing Names of Subs & Functions

Thread Tools

Display

Listing Names of Subs & Functions

Posting Permissions