Type mismatch??

[orange]

I'm trying to list all procs in all modules in current database. Getting type mismatch as identified below!!
I welcome any ideas/suggestions.

Public Sub ListProceduresInAllModules() 'tah college
    Dim modl As Module
    Dim lineNum As Long
    Dim procName As String
    
    For Each modl In Application.CurrentProject.AllModules  'type mismatch **************
        Debug.Print "Module: " & modl.Name
        
        lineNum = 1
        Do While lineNum < modl.CountOfLines
            procName = modl.ProcOfLine(lineNum, vbext_pk_Proc)
            If procName <> "" Then
                Debug.Print "  Procedure: " & procName
            End If
            lineNum = modl.ProcStartLine(procName, vbext_pk_Proc) + _
                modl.ProcCountLines(procName, vbext_pk_Proc)
        Loop
    Next modl
End Sub

[Micron]

try Dim modl as AccessObject

However, I think that will raise another error as I suspect AccessObject doesn't have a countoflines property. That suggests that you'd need to see if there is a child of AccessObject that leads you to a module object. Modules can be in the CurrentProject or CodeProject so maybe you need to reference the CodeProject instead.

[Gicu]

Hi Jack,
I think this should avoid that error:

Public Sub ListProceduresInAllModules() 'tah college
    Dim modl As Module
    Dim lineNum As Long
    Dim procName As String
    Dim obj as AccessObject
	
    For Each obj In Application.CurrentProject.AllModules  'type mismatch **************
        Set modl=Modules(obj.Name)
		Debug.Print "Module: " & modl.Name
        
        lineNum = 1
        Do While lineNum < modl.CountOfLines
            procName = modl.ProcOfLine(lineNum, vbext_pk_Proc)
            If procName <> "" Then
                Debug.Print "  Procedure: " & procName
            End If
            lineNum = modl.ProcStartLine(procName, vbext_pk_Proc) + _
                modl.ProcCountLines(procName, vbext_pk_Proc)
        Loop
    Next obj
End Sub

Cheers,

[orange]

Vlad,
I sent PM.
Here is the file.

[CJ_London]

my suggestion would be

Public Sub ListProceduresInAllModules() 'tah college
Dim lineNum As Long
Dim procName As String
Dim i As Integer
    
    For i = 0 To Application.CurrentProject.AllModules.Count - 1
    
        With Application.CurrentProject.AllModules(i)
            Debug.Print .Name
            lineNum = 1
            Do While lineNum < .CountOfLines
                procName = .ProcOfLine(lineNum, vbext_pk_Proc)
                If procName <> "" Then
                    Debug.Print "  Procedure: " & procName
                End If
                lineNum = .ProcStartLine(procName, vbext_pk_Proc) + _
                    .ProcCountLines(procName, vbext_pk_Proc)
            Loop
        End With
    Next i
    
End Sub

[orange]

Thanks for responding Micron, but that did not solve things.

[orange]

Thanks Chris for responding.
However, I get a runtime '438' Object doesn't support this property on this line.
Do While lineNum < .CountOfLines

[CJ_London]

Must admit when testing I commented out the loop as I was getting variable not declared error. Presume I needed to add a library but wasn’t sure which one.

just assumed it would work if you had the right library.

I tried Vlad's code, but got an error on the Set modl = Modules(obj.Name) line - typically the first two would be recognized and then I got a 'can't find the module' error

however I've taken a page out of his book and set an object

this works for me (except the commented out lines

Public Sub ListProceduresInAllModules() 'tah college
Dim lineNum As Long
Dim procName As String
Dim i As Integer
Dim modl As Module


    For i = 0 To Application.CurrentProject.AllModules.Count - 1


        With Application.CurrentProject.AllModules(i)
            Set modl = Modules(i)
            Debug.Print modl.Name
            lineNum = 1
            Do While lineNum < modl.CountOfLines
'                procName = .ProcOfLine(lineNum, vbext_pk_Proc)
'                If procName <> "" Then
'                    Debug.Print "  Procedure: " & procName
'                End If
'                lineNum = .ProcStartLine(procName, vbext_pk_Proc) + _
'                    .ProcCountLines(procName, vbext_pk_Proc)
                lineNum = lineNum + 1 ' need to remove this line when using the commented out code
            Loop
        End With
    Next i


End Sub

this version does all modules including forms/reports - but easy enough to exclude if you don't want them

Public Sub ListProceduresInAllModules() 'tah college
Dim lineNum As Long
Dim procName As String
Dim i As Integer


    For i = 0 To Modules.Count - 1


        With Modules(i)
            Debug.Print .Name
            lineNum = 1
            Do While lineNum < .CountOfLines
'                procName = .ProcOfLine(lineNum, vbext_pk_Proc)
'                If procName <> "" Then
'                    Debug.Print "  Procedure: " & procName
'                End If
'                lineNum = .ProcStartLine(procName, vbext_pk_Proc) + _
'                    .ProcCountLines(procName, vbext_pk_Proc)
                lineNum = lineNum + 1
            Loop
        End With
    Next i


End Sub

[orange]

Thanks Chris.

When I try vlad's routine, I get an immediate error here 7961 Can't find module basStripComments on the
Set modl = Modules(obj.Name) line. No module names are produced.

When I try your first routine (I called it Ajax3) I added a line to Print the number of modules it starts with.

Public Sub ListProceduresInAllModulesAjax3() 'tah college
Dim lineNum As Long
Dim procName As String
Dim i As Integer
Dim modl As Module

Debug.Print "Number of modules using Ajax3: " & Application.CurrentProject.AllModules.Count 'added for testing
    For i = 0 To Application.CurrentProject.AllModules.Count - 1

        With Application.CurrentProject.AllModules(i)
        
            Set modl = Modules(i)
             Debug.Print modl.Name
            lineNum = 1
            Do While lineNum < modl.CountOfLines
'                procName = .ProcOfLine(lineNum, vbext_pk_Proc)
'                If procName <> "" Then
'                    Debug.Print "  Procedure: " & procName
'                End If
'                lineNum = .ProcStartLine(procName, vbext_pk_Proc) + _
'                    .ProcCountLines(procName, vbext_pk_Proc)
                lineNum = lineNum + 1 ' need to remove this line when using the commented out code
            Loop
        End With
    Next i
End Sub

I get this output and it errors when i=3 saying runtime '452' invalid ordinal

Number of modules using Ajax3: 8
ModVlad
ModAjax3
------------------------------------------------------------------------------------------------------

When I try your second routine( I named Ajax2) again I added a line upfront to count the modules at the start.

Public Sub ListProceduresInAllModulesAjax2() 'tah college
Dim lineNum As Long
Dim procName As String
Dim i As Integer

 Debug.Print "Module count using ajax2: " & Modules.Count
    For i = 0 To Modules.Count - 1


        With Modules(i)
            Debug.Print .Name
            lineNum = 1
            Do While lineNum < .CountOfLines
'                procName = .ProcOfLine(lineNum, vbext_pk_Proc)
'                If procName <> "" Then
'                    Debug.Print "  Procedure: " & procName
'                End If
'                lineNum = .ProcStartLine(procName, vbext_pk_Proc) + _
'                    .ProcCountLines(procName, vbext_pk_Proc)
                lineNum = lineNum + 1
           Loop
        End With
    Next i


End Sub

I get this output

Module count using ajax2: 3
ModVlad
ModAjax3
ModAjax2

Very confusing because there are 8 modules. Here's a screenshot showing modules, the ajax3 module and the renamed sub (....ajax3)



Frustrating to say the least. Just trying to get modules and procs(subs/functions) with vba.
jack
----------------------------------------------------------------------------------------------------------

[Gicu]

Hi guys,
Sorry for delay in getting back, did some skiing today (last runs of the season )...
I have made some changes based on the updates here and some code I founf on MS's help site, but still running into problems; I think is due to the attempt to loop through the AllModules collection then getting the other one (Modules) to actually set the object. It runs OK for the first module then it says it cannot find the next one.
I'll try some more a bit later but here is what I have for now.

Public Sub ListProceduresInAllModules() 'tah college
    Dim modl As Module
    Dim lineNum As Long
    Dim procName As String
    'Dim obj As AccessObject
    Dim i As Integer, sModule As String
    
    'For Each obj In Application.CurrentProject.AllModules  'type mismatch **************
    For i = (Application.CurrentProject.AllModules.Count - 1) To 0 Step -1
        sModule = Application.CurrentProject.AllModules.Item(i).Name
        Set modl = Application.Modules(sModule)
        'Debug.Print "Module: " & modl.Name
        WRITE_ERROR_RESULTS ("Module: " & modl.Name)
        AllProcs (sModule)
'        lineNum = 1
'        Do While lineNum < modl.CountOfLines
'            procName = modl.ProcOfLine(lineNum, vbext_pk_Proc)
'            If procName <> "" Then
'                'Debug.Print "  Procedure: " & procName
'                WRITE_ERROR_RESULTS ("Procedure: " & procName)
'            End If
'            lineNum = modl.ProcStartLine(procName, vbext_pk_Proc) + _
'                modl.ProcCountLines(procName, vbext_pk_Proc)
'        Loop
    Next i
End Sub
Public Function AllProcs(ByVal strModuleName As String)
 
 Dim mdl As Module
 Dim lngCount As Long
 Dim lngCountDecl As Long
 Dim lngI As Long
 Dim strProcName As String
 Dim astrProcNames() As String
 Dim intI As Integer
 Dim strMsg As String
 Dim lngR As Long
 
 ' Open specified Module object.
 DoCmd.OpenModule strModuleName
 
 ' Return reference to Module object.
 Set mdl = Modules(strModuleName)
 
 ' Count lines in module.
 lngCount = mdl.CountOfLines
 
 ' Count lines in Declaration section in module.
 lngCountDecl = mdl.CountOfDeclarationLines
 
 ' Determine name of first procedure.
 strProcName = mdl.ProcOfLine(lngCountDecl + 1, lngR)
 
 ' Initialize counter variable.
 intI = 0
 
 ' Redimension array.
 ReDim Preserve astrProcNames(intI)
 
 ' Store name of first procedure in array.
 astrProcNames(intI) = strProcName
 
 ' Determine procedure name for each line after declarations.
 For lngI = lngCountDecl + 1 To lngCount
 ' Compare procedure name with ProcOfLine property value.
 If strProcName <> mdl.ProcOfLine(lngI, lngR) Then
 ' Increment counter.
 intI = intI + 1
 strProcName = mdl.ProcOfLine(lngI, lngR)
 ReDim Preserve astrProcNames(intI)
 ' Assign unique procedure names to array.
 astrProcNames(intI) = strProcName
 End If
 Next lngI
 
 strMsg = "Procedures in module '" & strModuleName & "': " & vbCrLf & vbCrLf
 For intI = 0 To UBound(astrProcNames)
 WRITE_ERROR_RESULTS ("    Procedure: " & strProcName)
 'strMsg = strMsg & astrProcNames(intI) & vbCrLf
 Next intI
 
 ' Message box listing all procedures in module.
 'MsgBox strMsg
End Function
Public Sub WRITE_ERROR_RESULTS(sResult As String)
Dim strLogPath As String, strCurrentMonth As String
Dim iFile As Integer, strLOG As String
On Error Resume Next


strCurrentMonth = CStr(DatePart("yyyy", Date)) & "_" & CStr(DatePart("m", Date))
'get application path
strLogPath = Application.CurrentProject.Path
'open file
iFile = FreeFile
strLOG = strLogPath & "\" & strCurrentMonth & "_" & "VBA_PROCEDURES.TXT"
Open strLOG For Append As iFile
'write the result line
Print #iFile, sResult
'close file
Close iFile
End Sub

Cheers,

[Gicu]

Quick addition, just read the documentation for the Modules object we've been trying to use and it only contains the open ones, which explains why you only 3 out of 8...
https://learn.microsoft.com/en-us/of...access.modules
Cheers,

[davegri]

I came up with this: sorry for the mishmash of messageboxes and debug.prints, but it's not a finished product for prime time, but lists all procedures in all modules.

EDIT: Vlad, using container object in procedure GetModules below will find all modules, open or not.

Sub GetModules()
    Dim mod1 As Document, db As dao.Database, lineNum As Long
    Dim ctn As Container
    Set db = CurrentDb
    Set ctn = db.Containers("Modules")
    With ctn
        For Each mod1 In ctn.Documents
            Call ListOfProcs(mod1.Name)
            'Debug.Print mod1.Name
'            Stop
        Next mod1
        
    End With
End Sub
Public Function ListOfProcs(ByVal strModuleName As String)
    '------------------------------------------------------
    'Courtesy : Microsoft Access
    '------------------------------------------------------
    Dim mdl As Module
    Dim linesCount As Long, DeclLines As Long
    Dim strProcName As String, lngR As Long, intJ As Integer
    Dim str_ProcNames() As String, lngK As Long
    Dim strMsg As String
    
    Set mdl = Modules(strModuleName)
    'Total Count of lines in the Module
    linesCount = mdl.CountOfLines
    Debug.Print "Module line count " & strModuleName, linesCount
    'Take the count of Global declaration lines
    DeclLines = mdl.CountOfDeclarationLines
    lngR = 1
    
    'The first line below the declaration lines
    'is the first procedure name in the Module
    strProcName = mdl.ProcOfLine(DeclLines + 1, lngR)
    'Re-dimension the str_ProcNames() Array for a single element
    'and save the procedure name in the Array.
    intJ = 0
    ReDim Preserve str_ProcNames(intJ)
    str_ProcNames(intJ) = strProcName
    'Determine procedure Name for each line after declaraction lines
    For lngK = DeclLines + 1 To linesCount
        'compare current Code-line’s procedure name with earlier line’s name
        'if not matching then we have encountered a new procedure name
        If strProcName <> mdl.ProcOfLine(lngK, lngR) Then
            'increment array index by one
            intJ = intJ + 1
            'get the procedure name of the current program line
            strProcName = mdl.ProcOfLine(lngK, lngR)
            'Redimension the array for a new element by
            'preserving the data of earlier elements
            ReDim Preserve str_ProcNames(intJ)
            'Save the procedure name in the array
            str_ProcNames(intJ) = strProcName
        End If
    Next lngK
    'create the list of Procedure Names from Array to display
    strMsg = "Procedures in the Module: " & strModuleName & vbCr
    For intJ = 0 To UBound(str_ProcNames)
        strMsg = strMsg & str_ProcNames(intJ) & vbCr
    Next
    MsgBox strMsg
End Function

[Gicu]

Hi Dave, thanks for that, I was looking into the Container object but it looks like I missed the fine print....
https://learn.microsoft.com/en-us/of...ner-object-dao

I confess I almost never used most of these objects and\or collections but it was a fun exercise !

Cheers,

[moke123]

I doubt it's what your looking for but I have code which returns the module names and their procedures as below.
I use 2 dictionaries, one which has the module names and the other the procedure names and which module they belong to.
I iterate through them to get the results below. Can optionally include form modules and procedures too.
It's part of helper form I have so all the code is within the one form.

Module1
          SomeSub

modLBX
          getLBX
          SelectLBX
          ClearList
          SelectAll
          DeSelectLbx
          fGetMatchIndex


clsFormNavBar
          InitCls
          m_objcFirst_Click
          m_objcPrevious_Click
          m_objcNext_Click
          m_objcLast_Click
          m_objcNewRec_Click
          m_objfrm_Current


modTempDataBase
          CreateOrReplaceTempDatabase
          sDeleteTempDB
          TDBPath
          fCreateTempDB
          UpdateExpiryProperty
          sSetExpiryProp
          fGetExpiry
          CreateTempTable
          UnLinkAllTempTables
          UnlinkTable


Module3
          ListAll
          fListModNames

[davegri]

Hi Dave, thanks for that, I was looking into the Container object but it looks like I missed the fine print....
https://learn.microsoft.com/en-us/of...ner-object-dao

I confess I almost never used most of these objects and\or collections but it was a fun exercise !

Cheers,

It is indeed, pretty obscure special purpose stuff in Access innards.