Function PrintProceduresAsItemsOfModules()
On Error GoTo ErrorHandler
Dim vbEditor As VBIDE.VBE
Dim VBProj As VBIDE.VBProject
Dim VBobj As VBIDE.VBComponent
Dim lngCount As Long
Dim lngCountDecl As Long
Dim lngI As Long
Dim strProcName As String
Dim intI As Integer
Dim lngR As Long
Dim arrCounter As Long
Dim FileNumber
Dim i As Long
Dim j As Long
Dim k As Long
Dim moduleNames() As Variant
Dim procNames() As Variant
arrCounter = 0
FileNumber = FreeFile
Kill "c:\myfile.txt" 'KILL OLD FILE
Open "c:\myfile.txt" For Output As #FileNumber
Set vbEditor = Application.VBE
Set VBProj = vbEditor.ActiveVBProject
'GET LIST OF MODULE NAMES ONLY (no forms, etc..)
For Each VBobj In VBProj.VBComponents
If VBobj.Type = vbext_ct_StdModule Then
ReDim Preserve moduleNames(arrCounter)
moduleNames(arrCounter) = VBobj.name
arrCounter = arrCounter + 1
End If
Next VBobj
arrCounter = 0
'SORT LIST OF MODULE NAMES
Call SortArray(moduleNames())
'LOOP MODULE COLLECTION AND PRINT INFO FOR MODULES IN ALPHA ORDER
For i = LBound(moduleNames()) To UBound(moduleNames())
For j = 1 To UBound(moduleNames()) + 1
'IF FOUND THE RIGHT MODULE, CONTINUE
If VBProj.VBComponents(j).name = moduleNames(i) Then
Set VBobj = VBProj.VBComponents(j)
With VBobj.CodeModule
lngCount = .CountOfLines
lngCountDecl = .CountOfDeclarationLines
'GET LIST OF PROCEDURE NAMES
ReDim procNames(arrCounter)
'GET FIRST PROC NAME
procNames(arrCounter) = .ProcOfLine(lngCountDecl + 1, lngR)
intI = 0
'LOOP MODULE'S NON-DECLARATION CODE LINES
For lngI = lngCountDecl + 1 To lngCount
'IF REACHED NEXT PROC
If procNames(arrCounter) <> .ProcOfLine(lngI, lngR) Then
intI = intI + 1
arrCounter = arrCounter + 1
ReDim Preserve procNames(arrCounter)
procNames(arrCounter) = .ProcOfLine(lngI, lngR)
End If
Next lngI
arrCounter = 0
'SORT PROC NAMES
Call SortArray(procNames())
Print #FileNumber, PrintHeader(VBobj.name)
'PRINT PROC NAMES TO FILE
For k = LBound(procNames()) To UBound(procNames())
If procNames(k) <> "" Then
Print #FileNumber, procNames(k) & "()"
End If
Next k
End With
'SPACE FOR NEXT MODULE PRINTOUT
Print #FileNumber, vbCrLf
End If
Next j
Next i
Close #FileNumber
Shell "notepad c:\myfile.txt", vbMaximizedFocus
Exit Function
ErrorHandler:
MsgBox (err.Description)
Set vbEditor = Nothing
Set VBProj = Nothing
End Function '//LL
