Public Function ListAllProcedures()
On Error Resume Next
Dim obj As Object
Dim i As Integer
Dim j As Long
Dim RetVar As Variant
Dim strText As String
strText = ""
'For Each obj In CurrentProject.allforms
' DoCmd.OpenForm obj.Name, acDesign
' If Forms(obj.Name).HasModule = True Then
' AllProcs ("Form_" & obj.Name)
' End If
'Next
'For Each obj In CurrentProject.AllReports
' DoCmd.OpenReport obj.Name, acDesign
' If Reports(obj.Name).HasModule = True Then
' AllProcs ("Report_" & obj.Name)
' End If
'Next
For i = 0 To CodeDb.Containers("Modules").Documents.Count - 1
RetVar = AllProcs(CodeDb.Containers("Modules").Documents(i).Name)
strText = strText + CodeDb.Containers("Modules").Documents(i).Name + "\n"
Next i
Filetest(strText)
End Function
------------------------------------------------------------------------------------------------------------------------------
Public Sub Filetest(ByVal strTextAs String)
Dim iFileNumber As Integer
Dim sFilename As String
Dim sDirectory As String
Dim sYourString As String
Dim sYourString2 As String
sDirectory = "C:\" & Hallo
sYourString = "Überschrift: "
sYourString2 = "++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++"
sFilename = Trim(Str(Year(Now()))) & "_" & Trim(Str(Month(Now()))) & "_" & Trim(Str(Day(Now()))) & ".txt"
iFileNumber = FreeFile
If Dir(sDirectory, vbDirectory) = "" Then MkDir (sDirectory)
Open sDirectory & sFilename & ".txt" For Append As iFileNumber
Print #iFileNumber, sYourString
Print #iFileNumber, sYourString2
Print #iFileNumber, strText
Close #iFileNumber
End Sub
------------------------------------------------------------------------------------------------------------------------------
Public Function AllProcs(strModuleName As String)
Dim mdl As Module
Dim lngCount As Long, lngCountDecl As Long, lngI As Long
Dim strProcName As String, astrProcNames() As String
Dim intI As Integer
Dim lngR As Long
Dim intBlankLineCount As Integer
' 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
For intI = 0 To UBound(astrProcNames)
Debug.Print strModuleName & " - " & astrProcNames(intI)
Next intI
End Function
