Attribute VB_Name = "modCallChain"
Option Explicit
'****************************************************************
'* This module can be used freely for any non-commercial use and
'* is presented here for educational purposes only.
'* Contact Computer Services Contracting at CoSeCo@CoSeCo.com
'* for permission to use this module or it's function for commercial
'* use.
'*
'****************************************************************
Public CallChain As New Collection
Private wTrace As Integer
Private lIndent As Long

Public Function fncAddProcedure(sName As String) As Long
Dim lCount As Long
    If Trace Then Indent = Indent + 1: Debug.Print String(Indent, "+") & "Add- " & sName
    lCount = CallChain.Count + 1
    CallChain.Add sName, CStr(lCount)
    fncAddProcedure = lCount
End Function

Public Sub subRemoveProcedureFromCallChain(lIndex As Long)
Dim l As Long
    If lIndex > CallChain.Count Then Err.Raise 6 ' overflow
    If lIndex < 1 Then Err.Raise 6 ' overflow
'    For l = lIndex To CallChain.Count
    For l = CallChain.Count To lIndex Step -1
        If Trace Then
            Debug.Print String(Indent, "-") & "Remove- " & CallChain.Item(l)
            If Indent > 0 Then
                Indent = Indent - 1
            End If
        End If
        CallChain.Remove (l)
    Next l
End Sub

Public Function fncGetCallChain(lIndex As Long) As String
Dim sCallChain As String
Dim l As Long
    If lIndex > CallChain.Count Then Err.Raise 6 ' overflow
    If lIndex < 1 Then Err.Raise 6 ' overflow
    sCallChain = ""
    For l = 1 To lIndex - 1
        sCallChain = sCallChain & CStr(l) & ")." & CallChain.Item(l) & vbCrLf
    Next l
    sCallChain = sCallChain & CStr(lIndex) & ")." & CallChain.Item(lIndex) & "   <=== Current Module " & vbCrLf
    If CallChain.Count > lIndex Then
        For l = lIndex + 1 To CallChain.Count
            sCallChain = sCallChain & CStr(l) & ")." & CallChain.Item(l) & vbCrLf
        Next l
        subRemoveProcedureFromCallChain (lIndex + 1)
    End If
    fncGetCallChain = sCallChain
End Function

Public Property Get Trace() As Integer
    If IsNull(wTrace) Then wTrace = False
    Trace = wTrace
End Property

Public Property Let Trace(ByVal iNewValue As Integer)
    wTrace = iNewValue
End Property

Public Property Get Indent() As Long
    If IsNull(lIndent) Then lIndent = 0
    Indent = lIndent
End Property

Public Property Let Indent(ByVal lNewValue As Long)
    lIndent = lNewValue
End Property