How to determine if a property in a class module is Let, Set or Get...

[GComyn]

Hello All...

I've been toying with a piece of code that will go through all of the modules in a database (the current one for now), and place into a table (will create it if it's not there) the following information:

Database Name
Database Path
Module Name
Procedure Order (What order in the module this procedure is)
Procedure Name
Procedure Lines (The actual code for the procedure)
Procedure Lines Count (How many lines of code)
Code Lines Count (how many lines in the entire module)
Module Type (regular module or class module)

I'll put the code at the end of this post (It's pretty long.....)

Ok... I can get the information from all regular modules or object modules (forms and reports), but class modules are giving me a problem. I can't seem to figure out how to differentiate between Let, Get and Set properties with the same name. If anyone out there can help me, that would be appreciated.

The reason I'm doing this (other than because....) is that I've got some similar code in several databases, and want to make sure that I don't duplicate too much... as well as making sure that when I update them, they all get updated.

Also (as you'll see from the code), If anyone can help me figure out how to 'enumerate' modules from another database into the current database, that would be great too!!!


Here is the code:

Public Function EnumerateModules() 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:
'------------------------------------------------------------------------------
'Possible Future changes:
'1  I want to get this fixed so that class modules will also be enumerated.
'   The problem is with the GET, LET and SET Properties. They are usually the
'   same name, so this sub will only get the first one.
'2  I'll probably change it so that the user will input a database, and it will
'   open that database and enumerate the modules in it.
'(not in that particular order.)
'Stan Paszt
'------------------------------------------------------------------------------
On Error GoTo ERR_EnumerateModules
    Dim dbCurrent As database
    Dim DB As database
    Dim rs As Recordset
    Dim doc As Document, rpt As Report, frm As Form
    Dim mdl As Module, bolIsLoaded As Boolean
    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
    
    DoCmd.SetWarnings False
    DoCmd.Hourglass True
    
    If IsTQ("", "tblModules") = False Then
        Call Create_tblModules_Table
    Else
        DoCmd.RunSQL ("Delete * from tblModules")
    End If
    ReDim strModuleType(0 To 2)
        strModuleType(0) = "Modules"
        strModuleType(1) = "Forms"
        strModuleType(2) = "Reports"
    
'    If (Trim$(strDatabasePath) = "") Then
'    '... then set Db to current Db.
        Set DB = CurrentDb()
        strDBPath = fhpIsolatePath(DB.Name)
        strDBName = fhpWithOutDir(DB.Name)
'    Else
'    'Otherwise, set Db to specified open database.
'        strDBPath = fhpIsolatePath(strDatabasePath)
'        strDBName = fhpWithOutDir(strDatabasePath)
'        Set db = DBEngine.Workspaces(0).OpenDatabase(strDatabasePath)
'    'See if an error occured.
'    End If
    
    Set dbCurrent = CurrentDb()
    Set rs = dbCurrent.OpenRecordset("tblModules") 'Open the table for writing
    intProcOrder = 0

'Move through the modules
    For intMT = 0 To 2 Step 1
        For Each doc In DB.Containers(strModuleType(intMT)).Documents
            Select Case strModuleType(intMT)
                Case "Modules"
                    intModuleType = acModule
                Case "Forms"
                    intModuleType = acForm
                Case "Reports"
                    intModuleType = acReport
            End Select
            bolIsLoaded = IsObjectOpen(intModuleType, doc.Name)
    
            'you can't open the module if it's already open.
            If bolIsLoaded = False Then
                Select Case intModuleType
                    Case acModule
                        DoCmd.OpenModule doc.Name
                    Case acForm
                        DoCmd.OpenForm doc.Name, acDesign
                        Set objTemp = Forms(doc.Name)
                        If objTemp.HasModule = False Then GoTo No_Module
                    Case acReport
                        DoCmd.OpenReport doc.Name, acViewDesign
                        Set objTemp = Reports(doc.Name)
                        If objTemp.HasModule = False Then GoTo No_Module
                End Select
            End If
            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
            
            lngCount = objTemp.CountOfLines
            
        'Declarations
            lngCountDecl = objTemp.CountOfDeclarationLines
            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
        
        'Check to see if there is anything else in the module
            If lngCount > lngCountDecl Then
                inti = lngCountDecl + 1
                intProcOrder = intProcOrder + 1
                strProcName = objTemp.ProcOfLine(inti, lngR)
                If intModuleType = acModule And objTemp.Type = acClassModule Then
                    'this does not work yet.
                Else
                    lngCountProcLines = objTemp.ProcCountLines(strProcName, vbext_pk_Proc)
                    strProcLines = objTemp.Lines(inti, lngCountProcLines)
                    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
                End If
                With rs
                    .AddNew
                    !DatabaseName = strDBName
                    !databasepath = strDBPath
                    !ModuleName = objTemp.Name
                    !CodeLinesCount = objTemp.CountOfLines
                    !ModuleType = objTemp.Type
                    !ProcedureName = strProcName
                    !ProcedureLines = strProcLines
                    !ProcedureLinesCount = lngCountProcLines
                    !ProcedureOrder = intProcOrder
                    .Update
                End With
                
            'Go through the rest of the module, enumerating the procedures
                For lngI = inti To lngCount
                    If strProcName <> objTemp.ProcOfLine(lngI, lngR) Then
                        intProcOrder = intProcOrder + 1
                        strProcName = objTemp.ProcOfLine(lngI, lngR)
                        If intModuleType = acModule And objTemp.Type = acClassModule Then
                            'this does not work yet.
                        Else
                            lngCountProcLines = objTemp.ProcCountLines(strProcName, vbext_pk_Proc)
                            strProcLines = objTemp.Lines(lngI, lngCountProcLines)
                            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
                        End If
                        With rs
                            .AddNew
                            !DatabaseName = strDBName
                            !databasepath = strDBPath
                            !ModuleName = objTemp.Name
                            !CodeLinesCount = objTemp.CountOfLines
                            !ModuleType = objTemp.Type
                            !ProcedureName = strProcName
                            !ProcedureLines = strProcLines
                            !ProcedureLinesCount = lngCountProcLines
                            !ProcedureOrder = intProcOrder
                            .Update
                        End With
                    End If
                Next lngI
            End If
            intProcOrder = 0
            lngCountProcLines = 0
            strProcLines = &quot; &quot;
No_Module:
            'was it loaded to begin with? If not, close it.
            Set objTemp = Nothing
            If bolIsLoaded = False Then
                DoCmd.close intModuleType, doc.Name, acSaveNo
            End If
        Next 'doc
    Next 'intMT

EXIT_EnumerateModules:
    rs.close: Set rs = Nothing
    DB.close: Set DB = Nothing
    DoCmd.Hourglass False
    DoCmd.SetWarnings True
    Exit Function
    
ERR_EnumerateModules:
    Select Case Err
        Case 0, 3022    'insert errors you wish to ignore
            Resume Next
        Case 7961       'trying to enumerate this module, but it wan't opened already.
            DoCmd.OpenModule doc.Name
        Case Else       'All other errors will be trapped here
            Beep
            MsgBox Err & &quot;: &quot; & Err.Description, vbCritical, _
                &quot;Error in function GeneralUtilitis.modEnumerateModules.EnumerateModules&quot;
            Resume EXIT_EnumerateModules
    End Select
    Resume 0        'FOR TROUBLESHOOTING
End Function

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

Public Function IsTQ(DbName As String, tname As String) As Integer
'***************************************************************
'FUNCTION: IsTQ()
'PURPSE: Determine if a table or query exists.
'ARGUMENTS:
'   DbNAme: The name of the database. If the database name is &quot;&quot;
'           the current database is used.
'    TName: The name of the table or query.
'RETURNS: True (exists) or False (not exist).
'****************************************************************
    Dim DB As database, Found As Integer, test As String
    Const NAME_NOT_IN_COLLECTION = 3265

'Assume the table or query does not exist.
    Found = False

'Trap for any errors.
    On Error Resume Next

'If the database name is empty...
    If (Trim$(DbName) = &quot;&quot;) Then
    '... then set Db to current Db.
        Set DB = CurrentDb()
    Else
    'Otherwise, set Db to specified open database.
        Set DB = DBEngine.Workspaces(0).OpenDatabase(DbName)
    'See if an error occured.
        If Err Then
            MsgBox &quot;Could not find database to open: &quot; & DbName
            IsTQ = False
            Exit Function
        End If
    End If
    
'See if the name is int he Tables collection.
    test = DB.TableDefs(tname).Name
    If Err <> NAME_NOT_IN_COLLECTION Then Found = True
    
'Reset the error variable.
    Err = 0
    
'See if the name is in the Queries collection.
    test = DB.QueryDefs(tname$).Name
    If Err <> NAME_NOT_IN_COLLECTION Then Found = True
    DB.close
    IsTQ = Found
End Function

That should be all of the code that you need. If you can help, that would be of great help!!!!!!

Gwydion