Since this will be a LIFO (Last In First Out) I have came up with the following. If anyone could suggest any improvements then they are most welcome.
Code:'CSEH: Skip Option Explicit Public colStacks() As String 'LAST IN FIRST OUT! Public Sub PushStack(ByVal strProcedure As String) 'when in error handling routine then don't register traces If SkipTrace = True Then Exit Sub If ArrayInit(Not colStacks) = False Then 'initialized ReDim Preserve colStacks(0) colStacks(0) = strProcedure Else 'increase size ReDim Preserve colStacks(UBound(colStacks) + 1) colStacks(UBound(colStacks)) = strProcedure End If End Sub Public Sub PopStack() If SkipTrace = True Then Exit Sub If ArrayInit(Not colStacks) = True Then If UBound(colStacks) = LBound(colStacks) Then Erase colStacks Else ReDim Preserve colStacks(UBound(colStacks) - 1) End If End If End Sub Public Function GetTraces() As String Dim strMessage As String Dim a As Long Dim b As Long If ArrayInit(Not colStacks) = True Then 'add the callers b = UBound(colStacks) For a = LBound(colStacks) To UBound(colStacks) If a = 0 Then strMessage = strMessage & ("[Stack " & Format$(b, "00000") & " of " & Format$(UBound(colStacks), "00000") & "] " & colStacks(a)) & vbNewLine Else strMessage = strMessage & (" [Stack " & Format$(b, "00000") & " of " & Format$(UBound(colStacks), "00000") & "] " & colStacks(a) & " was called by " & colStacks(a - 1)) & vbNewLine End If b = b - 1 Next End If If Len(strMessage) > 0 Then GetTraces = Mid$(strMessage, 1, Len(strMessage) - 2) Else GetTraces = strMessage End If End Function ' usage: If ArrayInit(Not ArrayName) Then ... Public Function ArrayInit(ByVal Not_Array As Long) As Boolean ArrayInit = Not (Not_Array = -1&) Debug.Assert App.hInstance End Function




Reply With Quote