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 <> "End function" Then
linepart() = Split(line, "function")
strpart() = Split(linepart(1), "(")
rc.AddNew
rc!fctname = Trim(strpart(0))
rc.Update
End If
stline = stline + 1
End If
Loop
rc.Close
db.ClosePublic 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 FunctionPublic 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
