List all functions in a Module(Here's a challenge! for you) 3

[Bullsandbears123]

Is there a way of automatically generating a list of Functions in a module?

I have a combo box I would like to fill with all the names of functions in "module2"

Thanks!

 

[GComyn]

Here is a Module that I created several years ago that will enumerate all modules in your forms, reports and modules containers.

It is very long, and includes 2 additional functions. One of the functions splits the path name from the it's component parts (drive, dir, filename, and ext).

The second one will create the table that is used in the main module.

As you can see... I got some help with this...

Here is the code:

'********* Code Starts Here ********
Option Compare Database
Option Explicit

Public Function EnumerateModules(strPath As String, strPassWord As String, Optional bolEmptytable As Boolean = True) As Boolean
'------------------------------------------------------------------------------
'Purpose: Go through all of the Modules in the specified database and put them
' into a table, creating the table if it does not exist.
'Parameters:
' strDatabasePath: The full path of the database you wish to enumerate;
' "" if you want the current database
'Sets: Puts all information into the table 'tblModules'. If it is not there,
' create the table
'Returns: Boolean value telling if it finished correctly, or there was an error.
'Author: Stan Paszt
'Created: 08/10/2001
'Modified:
'------------------------------------------------------------------------------
'Changes by Gary Walter 10/3/2001
'1) Added automation to always open another instance of "OtherDB."
'2) Expects full path to OtherDB even if same db as this one.
'3) Changed some fields in tblModules where info from OtherDB is stored.
'4) Added password parameter in case OtherDB secured.
'5) Now assumes tblModules exist.
'6) Added code to properly handle Property LET/GET/SET stmts.
'------------------------------------------------------------------------------
On Error GoTo ERR_EnumerateModules
Dim OtherDB As database
Dim strUserName As String
Dim strPass As String
Dim oAcc As Access.Application
Dim dbCurrent As database
Dim RS As Recordset
Dim doc As Document, rpt As Report, frm As Form
Dim mdl As Module, bolIsLoaded As Boolean, strDocName As String
Dim lngCount As Long, lngR As Long, intProcOrder As Integer
Dim lngCountDecl As Long, intI As Integer
Dim lngI As Long, lngCountProcLines As Long
Dim strProcName As String, strProcLines As String
Dim strModuleType() As String, intMT As Integer
Dim objTemp As Object, intModuleType As Integer
Dim strDBName As String, strDBPath As String
Dim strDrive As String, strDir As String, strFName As String, strExt As String
Dim varReturn As Variant
Dim lngOldProcType As Long, strOldProcName As String, strFinalProcName As String


DoCmd.Hourglass True

'clear table that will contain new module info
DoCmd.SetWarnings False
If bolEmptytable = True Then
DoCmd.RunSQL ("Delete * from tblModules&quot
End If
DoCmd.SetWarnings True

ReDim strModuleType(0 To 2)
strModuleType(0) = "Modules"
strModuleType(1) = "Forms"
strModuleType(2) = "Reports"


Call SplitPath(strPath, strDrive, strDir, strFName, strExt)
strDBPath = strDrive & strDir
strDBName = strFName & "." & strExt

'open recordset to tblModules in THIS database
Set dbCurrent = CurrentDb()
Set RS = dbCurrent.OpenRecordset("tblModules&quot


'open OTHER database
Set oAcc = New Access.Application
Set OtherDB = oAcc.DBEngine.OpenDatabase(strPath, False, False, ";PWD=" & strPassWord)
oAcc.OpenCurrentDatabase strPath

intProcOrder = 0

'Move through the modules
For intMT = 0 To 2 Step 1
For Each doc In OtherDB.Containers(strModuleType(intMT)).Documents
strDocName = doc.Name
Select Case strModuleType(intMT)
Case "Modules"
intModuleType = acModule
Case "Forms"
intModuleType = acForm
Case "Reports"
intModuleType = acReport
End Select
bolIsLoaded = IsObjectOpen(intModuleType, strDocName)
'you can't open the module if it's already open.
If bolIsLoaded = False Then
Select Case intModuleType
Case acModule
oAcc.DoCmd.OpenModule doc.Name
Set objTemp = oAcc.Modules(doc.Name)
Case acForm
oAcc.DoCmd.OpenForm strDocName, acDesign, , , acFormReadOnly, acWindowNormal
Set objTemp = oAcc.Forms(strDocName).Module
Case acReport
oAcc.DoCmd.OpenReport strDocName, acViewDesign
Set objTemp = oAcc.Reports(doc.Name).Module
End Select
Else
Select Case intModuleType
Case acModule
Set objTemp = Modules(doc.Name)
Case acForm
Set objTemp = Forms(doc.Name).Module
Case acReport
Set objTemp = Reports(doc.Name).Module
End Select
End If
'get number of lines in this module
lngCount = objTemp.CountOfLines
'Declarations
'find out how many lines in Declaration section
lngCountDecl = objTemp.CountOfDeclarationLines
'get code lines for Declaration section
strProcLines = objTemp.Lines(1, lngCountDecl)
Do Until (Asc(Left(strProcLines, 1)) <> 13 And Asc(Left(strProcLines, 1)) <> 10 _
And Asc(Left(strProcLines, 1)) <> 32)
strProcLines = Mid(strProcLines, 2)
Loop
Do Until (Asc(Right(strProcLines, 1)) <> 13 And Asc(Right(strProcLines, 1)) <> 10 _
And Asc(Right(strProcLines, 1)) <> 32)
strProcLines = Mid(strProcLines, 1, Len(strProcLines) - 1)
Loop
With RS
.AddNew
!DatabaseName = strDBName
!databasepath = strDBPath
!ModuleName = objTemp.Name
!CodeLinesCount = lngCount
!ModuleType = objTemp.Type
!ProcedureName = &quot;Declarations&quot;
!ProcedureLines = strProcLines
!ProcedureLinesCount = lngCountDecl
!ProcedureOrder = intProcOrder
.Update
End With
strOldProcName = &quot;Declarations&quot;
'Check to see if there is anything else after the declarations section
'Are there more lines in module than just the lines of Declaration?
If lngCount > lngCountDecl Then
'start at first line after Declaration section
intI = lngCountDecl + 1
intProcOrder = intProcOrder + 1
'***** Get Name of Proc of this line *********
'inti specifies the number of a line in the module.
'When return from getting the ProcOfLine,
'lngR will specify the type of procedure:
' vbext_pk_Get lngR=3 A Property Get proc
' vbext_pk_Let lngR=1 A Property Let proc
' vbext_pk_Proc lngR=0 A Sub or Function proc
' vbext_pk_Set lngR=2 A Property Set proc
strProcName = objTemp.ProcOfLine(intI, lngR)
'save proc name so will know when reach line with new proc
strOldProcName = strProcName
'save type of proc for next compare (to distinguish same-name Property stmts)
lngOldProcType = lngR
'If proc was a property stmt, add type to procname that will save in tblModules
Select Case lngOldProcType
Case vbext_pk_Proc
strFinalProcName = strProcName
Case vbext_pk_Get
strFinalProcName = strProcName & &quot; [Property Get]&quot;
Case vbext_pk_Let
strFinalProcName = strProcName & &quot; [Property Let]&quot;
Case vbext_pk_Set
strFinalProcName = strProcName & &quot; [Property Set]&quot;
End Select
'****** update progress display in status bar *****************
varReturn = SysCmd(acSysCmdSetStatus, &quot;Processing &quot; _
& strModuleType(intMT) & &quot; &quot; & doc.Name & &quot;.... Procedure &quot; & strFinalProcName)

'get the number of lines for this proc
lngCountProcLines = objTemp.ProcCountLines(strProcName, lngR)

'get the code lines for this proc
strProcLines = objTemp.Lines(intI, lngCountProcLines)
'strip CRLF's and SPACES from left side of codelines
Do Until (Asc(Left(strProcLines, 1)) <> 13 And Asc(Left(strProcLines, 1)) <> 10 _
And Asc(Left(strProcLines, 1)) <> 32)
strProcLines = Mid(strProcLines, 2)
Loop
'strip CRLF's and SPACES from right side of codelines
Do Until (Asc(Right(strProcLines, 1)) <> 13 And Asc(Right(strProcLines, 1)) <> 10 _
And Asc(Right(strProcLines, 1)) <> 32)
strProcLines = Mid(strProcLines, 1, Len(strProcLines) - 1)
Loop
'for html coding (you probably want to delete the following)
'if have a Proc (not a Property stmt),
'add &quot;Sub&quot; or &quot;Function&quot; to start of proc name
If lngOldProcType = vbext_pk_Proc Then
If Left(strProcLines, 15) = &quot;Public Function&quot; _
Or Left(strProcLines, 16) = &quot;Private Function&quot; Then
strFinalProcName = &quot;Function &quot; & strFinalProcName
Else
strFinalProcName = &quot;Sub &quot; & strFinalProcName
End If
End If
With RS
.AddNew
!DatabaseName = strDBName
!databasepath = strDBPath
!ModuleName = objTemp.Name
!CodeLinesCount = lngCount
!ModuleType = objTemp.Type
!ProcedureName = strFinalProcName
!ProcedureLines = strProcLines
!ProcedureLinesCount = lngCountProcLines
!ProcedureOrder = intProcOrder
.Update
End With
'Go through the rest of the module, enumerating the procedures
For lngI = intI To lngCount

'***** Get Name of Proc of this line *********
'inti specifies the number of a line in the module.
'When return from getting the ProcOfLine,
'lngR will specify the type of procedure:
' vbext_pk_Get lngR=3 A Property Get proc
' vbext_pk_Let lngR=1 A Property Let proc
' vbext_pk_Proc lngR=0 A Sub or Function proc
' vbext_pk_Set lngR=2 A Property Set proc
strProcName = objTemp.ProcOfLine(lngI, lngR)
'see if ProcName for this line has changed
'or ProcName is the same but have different ProcType
If (strProcName <> strOldProcName) _
Or ((strProcName = strOldProcName) And (lngR <> lngOldProcType)) Then

intProcOrder = intProcOrder + 1

'save proc name so will know when reach line with new proc
strOldProcName = strProcName
'save type of proc for next compare (to distinguish same-name Property stmts)
lngOldProcType = lngR
'If proc was a property stmt, add type to procname that will save in tblModules
Select Case lngOldProcType
Case vbext_pk_Proc
strFinalProcName = strProcName
Case vbext_pk_Get
strFinalProcName = strProcName & &quot; [Property Get]&quot;
Case vbext_pk_Let
strFinalProcName = strProcName & &quot; [Property Let]&quot;
Case vbext_pk_Set
strFinalProcName = strProcName & &quot; [Property Set]&quot;
End Select
'****** update progress display in status bar *****************
varReturn = SysCmd(acSysCmdSetStatus, &quot;Processing &quot; _
& strModuleType(intMT) & &quot; &quot; & doc.Name & &quot;.... Procedure &quot; & strFinalProcName)

'get the number of lines for this proc
lngCountProcLines = objTemp.ProcCountLines(strProcName, lngR)
'get the code lines for this proc
strProcLines = objTemp.Lines(lngI, lngCountProcLines)
'strip CRLF's and SPACES from left side of codelines
Do Until (Asc(Left(strProcLines, 1)) <> 13 And Asc(Left(strProcLines, 1)) <> 10 _
And Asc(Left(strProcLines, 1)) <> 32)
strProcLines = Mid(strProcLines, 2)
Loop
'strip CRLF's and SPACES from right side of codelines
Do Until (Asc(Right(strProcLines, 1)) <> 13 And Asc(Right(strProcLines, 1)) <> 10 _
And Asc(Right(strProcLines, 1)) <> 32)
strProcLines = Mid(strProcLines, 1, Len(strProcLines) - 1)
Loop
'for html coding (you probably want to delete the following)
'if have a Proc (not a Property stmt),
'add &quot;Sub&quot; or &quot;Function&quot; to start of proc name
If lngOldProcType = vbext_pk_Proc Then
If Left(strProcLines, 15) = &quot;Public Function&quot; _
Or Left(strProcLines, 16) = &quot;Private Function&quot; Then
strFinalProcName = &quot;Function &quot; & strFinalProcName
Else
strFinalProcName = &quot;Sub &quot; & strFinalProcName
End If
End If
With RS
.AddNew
!DatabaseName = strDBName
!databasepath = strDBPath
!ModuleName = objTemp.Name
!CodeLinesCount = lngCount
!ModuleType = objTemp.Type
!ProcedureName = strFinalProcName
!ProcedureLines = strProcLines
!ProcedureLinesCount = lngCountProcLines
!ProcedureOrder = intProcOrder
.Update
End With
End If
'look at next line in code module
Next lngI
'finished getting all info from this module
'/* End of If lngCount > lngCountDecl Then
End If
'reinit vars to get a new module
intProcOrder = 0
lngCountProcLines = 0
strProcLines = &quot; &quot;
No_Module:
'close object that contained last code module
Set objTemp = Nothing
oAcc.DoCmd.close intModuleType, doc.Name, acSaveNo
'go get another code module of the same module type
Next 'doc
'have gotten all code modules for this type
'so start getting another type of module
Next 'intMT

'****** update progress display in status bar *****************
varReturn = SysCmd(acSysCmdClearStatus)
MsgBox &quot;Processing Complete&quot;
EnumerateModules = True

EXIT_EnumerateModules:
oAcc.CloseCurrentDatabase
OtherDB.close: Set OtherDB = Nothing
RS.close: Set RS = Nothing
dbCurrent.close: Set dbCurrent = Nothing
DoCmd.Hourglass False
DoCmd.SetWarnings True
Exit Function

ERR_EnumerateModules:
EnumerateModules = False
MsgBox Err & &quot;: &quot; & Err.Description, vbCritical, _
&quot;Error in function basModuleCode.EnumerateModules&quot;
Resume EXIT_EnumerateModules
End Function

Sub SplitPath(strPath As String, _
strDrive As String, _
strDir As String, _
strFName As String, _
strExt As String)

Dim intPos As Integer ' current position of Dim intLast As Integer ' last position of Dim strTemp As String

If Len(strPath) < 3 Or IsNull(strPath) Then Exit Sub

strDrive = Left(strPath, 2)

'find position of last &quot;\&quot;
intPos = InStr(strPath, &quot;\&quot
While intPos <> 0
intLast = intPos
intPos = InStr(intPos + 1, strPath, &quot;\&quot
Wend
If intLast > 3 Then
strDir = Mid(strPath, 3, intLast - 3)
Else
strDir = &quot;&quot;
End If
'get FName and Ext
strTemp = Mid(strPath, intLast + 1)
intPos = InStr(strTemp, &quot;.&quot
If intPos <> 0 Then 'found a &quot;.&quot;
strExt = Mid(strTemp, intPos + 1)
strFName = Left(strTemp, intPos - 1)
Else 'did not find &quot;.&quot; so no extension
strExt = &quot;&quot;
strFName = strTemp
End If

End Sub


Private Sub Create_tblModules_Table()
Dim tdf As TableDef
Dim idxPrimary As index

Set tdf = CurrentDb.CreateTableDef(&quot;tblModules&quot
With tdf
.Fields.Append .CreateField(&quot;DatabaseName&quot;, dbText, 50)
.Fields.Append .CreateField(&quot;DatabasePath&quot;, dbText, 255)
.Fields.Append .CreateField(&quot;ModuleName&quot;, dbText, 50)
.Fields.Append .CreateField(&quot;ProcedureOrder&quot;, dbLong)
.Fields.Append .CreateField(&quot;ProcedureName&quot;, dbText, 50)
.Fields.Append .CreateField(&quot;ProcedureLines&quot;, dbMemo)
.Fields.Append .CreateField(&quot;ProcedureLinesCount&quot;, dbLong)
.Fields.Append .CreateField(&quot;CodeLinesCount&quot;, dbLong)
.Fields.Append .CreateField(&quot;ModuleType&quot;, dbLong)
End With
CurrentDb.TableDefs.Append tdf
Set tdf = Nothing
End Sub

'******** Code Ends Here ********

Hope this help.

GComyn

 

[Bullsandbears123]

Thanks for posting the code. I tried running it and I got an error at

bolIsLoaded = IsObjectOpen(intModuleType, strDocName)
I'm missing the &quot;IsObjectOpen&quot; Function. It's going to take me a while to figure this out.

Do you know if there is a quick way to reference the 1st, 2nd 3rd etc. functions with a (index) number.
EXAMPLE:
module(1).Function(1).name would be the name of the first function in the first module

Module(1).Function(2).name would be the name of the 2nd Function in the First Module.

Module(2).Function(2).name would be the name of the 2nd Function in the 2nd Module.

Thanks for all your help!! It is appreciated.

 

[bitbuster]

Hello,

I also have a solution. I may not have all the errorhandles covered but it is a lot shorter and simpler to handle for a beginning programmer:

Dim mo As Module
Dim stline As Long
Dim stcol As Long
Dim eline As Long
Dim ecol As Long
Dim line As String
Dim strpart() As String
Dim linepart() As String
Dim db As database
Dim rc As Recordset
DoCmd.RunSQL "delete * from buffertable"
Set db = CurrentDb
Set rc = db.OpenRecordset("buffertable")

Set mo = Modules("Module2")
Do Until stline = mo.CountOfLines + 1
If mo.Find("Function", stline, stcol, eline, ecol) Then
    line = mo.Lines(stline, 1)
    If line <> &quot;End function&quot; Then
        linepart() = Split(line, &quot;function&quot;)
        strpart() = Split(linepart(1), &quot;(&quot;)
        
        rc.AddNew
        rc!fctname = Trim(strpart(0))
        rc.Update
    End If
    stline = stline + 1
End If
Loop
rc.Close
db.Close

Regards,

Bitbuster

 

[cmmrfrds]

You might be able to get the information out of the MSysObjects Table (a hidden table). I believe the information is stored recursively in this table.

Do a
Select * From MSysObjects


A possible query.
SELECT MSysObjects.Name, MSysObjects.Id, MSysObjects_1.Id, MSysObjects_1.ParentId, MSysObjects_1.Name, MSysObjects_1.Type
FROM MSysObjects AS MSysObjects_1 INNER JOIN MSysObjects ON MSysObjects_1.ParentId = MSysObjects.Id
WHERE (((MSysObjects.Name)=&quot;Scripts&quot);

 

[MichaelRed]

'looks like' a celebrate diversity day! So far at least, no specific soloution to the issue as stated, although some / several good soloutions to the more general issue.

The GComyn will generate WAY more info then desired / necessary, although it does persue the issue through form and report modules and it permits the use of the procedure on a db other than the currrent, so, one might use it to get a comprehensive listing of ALL of hte procedures in use throughout an enterprise (although some code would need to added to find, list and successively retrieve the procedures from the disseparatedatabases.

The cmmrfrds soloution is, I believe, incorrect in two respects. First, MSysObjects lists only the 'top level' objects from the object types, thus shows the MODULES, but not the individual procedures within the modules. Second, &quot;Scripte&quot; refer to the dreaded MACRO object, not modules at all. Although using MSysObject as a way to get the module names is interesting - but only if the 'listing is restricted to the standard type of module as this will not reveal any form or report module.

bitbuster is surely the closest to the question AS ASKED, since that soloution attempts to return specifically the names of FUNCTIONS in the module, however it fails to address the possibility of a SUB being in the module. It is further limited in that hte module name is hard coded into the procedure, thue either it is of use only if one happens to have and want the FUNCTION names only from a &quot;Module2&quot; in the current db, or the programmer is willing and able to replace the name every time they choose to find the function names in another module.


First, I retrieve the entire declaration line, as opposed to the procedure name alone. This is, on my part deliberate, as I intend to use the process in a wider scope and expect to find names of procedures which are repeated -but whaich are NOT identical, thus the argument list and return type are of particular interest to me. Second, again, because of the wider usage envisioned, I place the info in a table - although Bullsandbears123 (hmmm... stock market neophytes?) never quite get around to the details of the combobox, so a table is not necessarily inappropiate. Third, and again as a step toward the wider application, I have generated two procedures. One of these simply collects the STANDARD modules' names and then calls the one which retrieves the procedure (Sub and Function) names from each module in turn. For Bullsandbears123, perhaps the second is sufficient? Although there are pitfals to the stand alone use. Since the information in any part of an Ms. A. db is generally somewhat fluid, peocedures which 'document' aspects of the db are generally no more current than hte most recent database change, so these 'documentation' procedures should be run frequently, otherwise the 'documentation' is out of date and therefore at least mis-leading. In my more general process, I 'flush' the previous content in the procedure which collects the module names, which using the procedure to find the procedure names simply adds the naems to the table. Obviously, wh=en the procedure is re-run, the table needs to be 'flushed' and the content re-built. In &quot;My&quot; version, this would need to either be included in the procedure, or run as a seperate process prior to the re-population of the table.

Finally, IF one wants to try my version, you need to 'build' the table with the two fields. I use 'tblProcedures' with fields ModuleName (text 50) and ProcedureCall (text 150),






MichaelRed
m.red@att.net

Searching for employment in all the wrong places

 

[MichaelRed]

Then again, actually posting the code would give others the opportunity to critique it?

This collect the names of the standard modules in the db. It 'flushes' the table of procedure names prior to calling the &quot;Find Procedures&quot;.

Public Function basFindMdl()

    Dim obj As AccessObject
    Dim dbs As Object
    Dim strMdl() As String
    Dim Idx As Integer

    Set dbs = Application.CurrentProject

    ReDim strMdl(0)

    For Each obj In dbs.AllModules
        strMdl(UBound(strMdl)) = obj.Name
        ReDim Preserve strMdl(UBound(strMdl) + 1)
    Next obj

    ReDim Preserve strMdl(UBound(strMdl) - 1)

    Dim strSQL As String

    strSQL = "Delete * from tblProcedures;"
    DoCmd.RunSQL strSQL

    Application.Echo False
    While Idx <= UBound(strMdl)
        basfindProc (strMdl(Idx))
        Debug.Print strMdl(Idx)
        Idx = Idx + 1
    Wend
    Application.Echo True

End Function

This oone gets JUST the procedure names in the module who's n ame is passed into it. It DOES NOT 'flush' the contents of the table, so that needs to either be added or done seperatly.

Public Function basfindProc(mdlName As String)

    Dim obj As AccessObject
    Dim dbs As Object

    Dim DAOdb As DAO.Database
    Dim rst As DAO.Recordset
    Dim mdl As Module
    Dim Idx As Long
    Dim Jdx As Long
    Dim MyLine As String
    Dim intProc As Integer
    Dim strProcLn(5) As String

    strProcLn(0) = "Private Sum"
    strProcLn(1) = "Private Function"
    strProcLn(2) = "Public Sub"
    strProcLn(3) = "Public Function"
    strProcLn(4) = "Sub"
    strProcLn(5) = "Function"

    Set dbs = Application.CurrentProject
    Set DAOdb = CurrentDb
    Set rst = DAOdb.OpenRecordset("tblProcedures", dbOpenDynaset)


    ' Search for a procedure declaration lines
    
    Idx = 1
    DoCmd.OpenModule (mdlName)
    Set mdl = Modules(mdlName)
    While Idx <= mdl.CountOfLines
        MyLine = mdl.Lines(Idx, 1)

        Jdx = 0
        Do While Jdx <= UBound(strProcLn)
            intProc = InStr(MyLine, strProcLn(Jdx))
            If (intProc = 1) Then
                With rst
                    .AddNew
                    !modulename = mdlName
                    !ProcedureCall = MyLine
                    .Update
                End With
                Exit Do
            End If
            Jdx = Jdx + 1
        Loop

        Idx = Idx + 1
    Wend
    DoCmd.Close acModule, mdlName

End Function

MichaelRed
m.red@att.net

Searching for employment in all the wrong places

 

[oharab]

Have a star Michael.

Bulls,
The question noone seems to have asked is why on earth would you want to run module(2).Procedure3? The position of code in module is purely arbritary and there is no reason I can think of that would need this sort of construct.
If you know that you are after the 2nd procedure, you should know the name of it!
If you are trying to run different procs depending on different criteria then I suggest you look into parameters and select case constructs.


hth

Ben

----------------------------------------------
Ben O'Hara

http://www.RobotParade.co.uk

&quot;Where are all the stupid people from...
...And how'd they get so dumb?&quot;
NoFX-The Decline
----------------------------------------------

 

[Bullsandbears123]

Michael,

Pure genius!!! Thank You! You definitely deserve a STAR!

This is going to help a lot. As for critique of your code, as far as I am concerned it solved my problem so it is PERFECT! I will however try to edit the results so only the name appears not the “Function” before or the parameters “(parameters as string)” after. And by changing the following code with an extra space after the words it won’t pull up the word “Subject” when it’s looking for “sub”.

strProcLn(2) = &quot;Public Sub &quot;
strProcLn(4) = &quot;Sub &quot;

In addition, BullsandBears could be the Chicago Bulls and Chicago Bears, but you’re correct I am a newbie investor, NOT trader or speculator.

I also noticed “Searching for employment in all the wrong places”, are you currently looking for a job? b/c if you are, I may know a company that is looking for someone with your skills to help maintain their IS systems.

 

[MichaelRed]

Mors important item first, YES, I am DEFFINITLY looking for 'gainful employment'. ANY referal is appreciated.

Otherwise, I do not know how / why you need the space. &quot;Sub?&quot; should not be able to occur in such a position within a module? &quot;private Sub&quot;; Public Sub&quot;; or &quot;SUB&quot; would have to appear at the first character position of a line. This would SEEM to preclude ~~ 99.999999% of any / all possabilities. The ONLY exception I could forsee is a &quot;continuation&quot; line, where the line places the first character in this position AND the line starts with one of the three (YES, &quot;3&quot variations. If your 'code' does happen to be set up like that, it would SEEM to me that you should &quot;pad&quot; all of the tests for a procedure name with the trailing space.


P.S. thanks for the stars!




MichaelRed
m.red@att.net

Searching for employment in all the wrong places

 

[combo]

Hi all,
very nice solutions, let me add another one.

1. reference to Microsoft Visual Basic for Applications Extensibility 5.3,

2. class module named ModInfo with following code:
[tt]Private oMod As CodeModule
Private vPrInfo() As vProcInfo
Private iNoOfProcs As Integer
Private i As Long, j As Long
Private sProc As String, sProcLine As String
Private tProc As vbext_ProcKind
Private sProcWords() As String

Public Property Set Object(ByVal oNewModule As CodeModule)
Set oMod = oNewModule
ReDim vPrInfo(0)
iNoOfProcs = 0
With oMod
i = .CountOfDeclarationLines + 1
Do While i < .CountOfLines
sProc = .ProcOfLine(i, vbext_pk_Proc)
j = .ProcBodyLine(sProc, vbext_pk_Proc)
sProcLine = .Lines(j, 1)
sProcLine = LTrim(sProcLine)
sProcWords = Split(sProcLine, , , vbTextCompare)
iNoOfProcs = iNoOfProcs + 1
ReDim Preserve vPrInfo(iNoOfProcs)
vPrInfo(iNoOfProcs).ProcName = sProc
If sProcWords(0) = &quot;Sub&quot; Or sProcWords(1) = &quot;Sub&quot; Then
vPrInfo(iNoOfProcs).ProcType = &quot;Sub&quot;
ElseIf sProcWords(0) = &quot;Function&quot; Or sProcWords(1) = &quot;Function&quot; Then
vPrInfo(iNoOfProcs).ProcType = &quot;Function&quot;
End If
vPrInfo(iNoOfProcs).ProcLine = i
vPrInfo(iNoOfProcs).ProcBodyLine = j
vPrInfo(iNoOfProcs).ProcLength = .ProcCountLines(sProc, vbext_pk_Proc)
vPrInfo(iNoOfProcs).ProcText = .Lines(j, vPrInfo(iNoOfProcs).ProcLength - (j - i))
i = i + .ProcCountLines(sProc, vbext_pk_Proc)
Loop
End With
End Property

Public Property Get ProcInfo(ProcNo As Integer) As vProcInfo
ProcInfo = vPrInfo(ProcNo)
End Property

Public Property Get NoOfProcs() As Integer
NoOfProcs = iNoOfProcs
End Property[/tt]

3. standard module &quot;Module1&quot; with code (only type is necessary, the rest is to test it):
[tt]Public Type vProcInfo
ProcName As String
ProcType As String
ProcLine As Long
ProcBodyLine As Long
ProcLength As Long
ProcText As String
End Type

Sub test()
Dim x As New ModInfo
Dim i As Integer
Set x.Object = Application.VBE.ActiveVBProject.VBComponents(&quot;Module1&quot.CodeModule
For i = 1 To x.NoOfProcs
Debug.Print i, x.ProcInfo(i).ProcName, x.ProcInfo(i).ProcType
Next i
Set x = Nothing
End Sub[/tt]

This can be transferred to other office applications, for instance
excel:
Set x.Object = ThisWorkbook.VBProject.VBComponents(&quot;Module1&quot.CodeModule
word:
Set x.Object = ThisDocument.VBProject.VBComponents(&quot;Module1&quot.CodeModule

combo

 

[krinid]

combo,
By changing the "Module1" to another component, does that work for all component types? (I tried it on a form and it errored).

 

[krinid]

(Maybe I should mentioned that I took your advice of being able to use it in Excel and am using the Set x.Object = ThisWorkbook.VBProject.VBComponents("Module1").CodeModule line - but I guess it shouldn't really be in this forum anymore if it's Excel...)

 

[combo]

Krinid,
for a userform in excel works for me (public type 'vProcInfo' declared in a standard module is necessary, can be a new class instead, with some modifications in 'ModInfo' class):
[tt]Set x.Object = ThisWorkbook.VBProject.VBComponents("UserForm1").CodeModule[/tt]

In access, for a form named 'F1' (access name, 'Form_F1' in VBE project explorer) with module and some code, works:
[tt]Set x.Object = Application.VBE.ActiveVBProject.VBComponents("Form_F1").CodeModule[/tt]

Class' code can be easily extended to include property procedures for class modules.
Maybe there is a better reference to VBA project in access (project name for instance), access is not my daily application I work with.

combo