UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
2 Pages V < 1 2  (Go to first unread post)
   Reply to this topicStart new topic
> How Can I Access The Call Stack In VBA    
 
   
JHolm
post Jun 6 2018, 12:53 PM
Post#21



Posts: 113
Joined: 7-July 15
From: BC Canada


Jon,

The vbWatchDog addin that Daniel linked doesn't require any additional software to be installed on client computers. As the developer you have it as an Access addin. It inserts several class modules into any project you use it with and everything runs off those. So the vbWatchDog code is simply part of the Access file that you distribute to your users.

Jeff
Go to the top of the page
 
nuclear_nick
post Jun 6 2018, 01:04 PM
Post#22



Posts: 1,566
Joined: 5-February 06
From: Ohio, USA


CODE
The vbWatchDog addin that Daniel linked doesn't require any additional software to be installed on client computers.


Just done properly, costs you $150.

And deprives you of all these wonderful teaching moments.

fundrink.gif

--------------------
"Nuclear" Nick
____________
The top three reasons to hide code; 1) It's not your own. 2) It's your own, but it's so crappy you don't want anyone to see it. 3) The comments in your code would get you in a lot of trouble if ever made public.
Go to the top of the page
 
isladogs
post Jun 6 2018, 03:57 PM
Post#23



Posts: 386
Joined: 4-June 18



Jon
Your screenshot certainly shows you get useful error information.
However, its not clear(to me) from that alone whether you get more than using my approach (see post #8)

Attached File  ErrorLogMessage.PNG ( 18.88K )Number of downloads: 4


Attached File  ErrorLogForm.PNG ( 60.97K )Number of downloads: 9


Attached File  ErrorLogEmail.PNG ( 13.38K )Number of downloads: 3


If you are able & willing to upload an example database, it would be nice to test yours out for comparison

Also although I also use MZ Tools, you can get the procedure name with no add-in tools by making use of the VBE Extensibility library

CODE
Private Sub SomeProcName()

On Error GoTo Err_Handler

...other code here
    
Exit_Handler:
    Exit Sub

Err_Handler:
    'get proc name
    strProc = Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
   'create error message & log
    PopulateErrorLog
    Resume Exit_Handler
    
End Sub


This is the main code used to create the error log & email

CODE
Public Function PopulateErrorLog()

'This function creates error log & error message
'***NOTE: Can't use error handling in this procedure as it stops logging!***

'On Error GoTo Err_Handler
'On Error Resume Next

If Err = 13 Or Err = 35 Then Exit Function  

'add record to table tblSystemErrorLog & creates formatted error message
    
    lngError = Err.Number
    strErrDescription = Err.Description
    
   ' strProc = Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
  
      If strItemName = "MainMenu" Or strItemName = "AdminMenu" Then
            strErrSelection = IIf(strMenuItem <> "", " - Item " & intMenuItem & " ( " & strMenuItem, "") & _
                IIf(strSubMenuItem <> "", " / " & strSubMenuItem, "") & IIf(strFormMenuItem <> "", " / " & strFormMenuItem, "") '                
                If strErrSelection <> "" Then strErrSelection = strErrSelection & " )"
        Else
            strErrSelection = ""
        End If          
  
   If GetErrorLoggingStatus = "Yes" Then
        'set up error log entry
        If lngError <> 0 Then
            DoCmd.SetWarnings False
                
            DoCmd.RunSQL "INSERT INTO tblSystemErrorLog ( TeacherID, DateTimeStamp, ItemType, ItemName, ProcedureName, ItemNumber," & _
                " Error, Description, LoginID, WorkstationID, SDAVersion, AccessVersion )" & _
                " SELECT GetLoggedOnTeacher() AS TeacherID, Now() AS DateTimeStamp, GetItemType() AS ItemType, GetItemName() AS ItemName," & _
                " GetProc() AS ProcedureName, GetItemNo() AS ItemNumber, GetErrNumber() AS Error, GetErrDescription() AS Description," & _
                " Nz(GetLoginID(),0) AS LoginID, GetWorkstationName() AS WorkstationID, GetVersionNumber() AS SDAVersion," & _
                " GetAccessVersionName() & ' ' & GetAccessBuildVersion() AS AccessVersion;"
                
            DoCmd.SetWarnings True
        End If
                
        If GetSDAManagerStatus = True Then
            'create error message
             DoCmd.OpenForm "frmErrorMessage", , , , , , "SDAManager"
             EMailErrorMessage
                
        ElseIf GetSchConstantsValue("strEmailErrorLogs") = "Yes" And Emailflag = "Yes" Then
            'Send email
            EMailErrorMessage
            
            'create error message
            DoCmd.OpenForm "frmErrorMessage", , , , , , "EmailLog"
        Else
            'create error message
            DoCmd.OpenForm "frmErrorMessage", , , , , , "NoEmailLog"
        End If
        
        DoEvents
        
        If ErrorFlag = False Then ClearErrorLogItems
    
    ElseIf GetErrorLoggingStatus = "No" Then
        'error logging disabled - create 'standard' error message
        FormattedMsgBox "Error " & Err.Number & " in " & strProc & " procedure : " & _
            "@" & Err.Description & "       " & vbNewLine & vbNewLine & _
            "Please inform the system manager about this error message      @", vbExclamation, "Program Error"
    
    Else
        'table links removed -no code here
        Exit Function
    End If
    
    Err.Clear
    
Exit_Handler:
    Exit Function
    
Err_Handler:
    strProc = "PopulateErrorLog"
    MsgBox "Error " & Err.Number & " in " & strProc & " procedure : " & Err.Description
    Resume Exit_Handler

End Function

This post has been edited by isladogs: Jun 6 2018, 04:28 PM

--------------------
nil illigetimi carborundem est
Go to the top of the page
 
JonSmith
post Jun 6 2018, 04:39 PM
Post#24



Posts: 3,691
Joined: 19-October 10



@JHolm thats super interesting to me then. I'd love to see how it manages all that information without requiring extra software. I'll certainly look into this further.

'isladogs, happy to share! I'll need more time at my desk but my logging class is something I'm quite proud of at this point. Based on your examples I think you have really strong error logging yourself too but this can add to it even more.

JS
Go to the top of the page
 
isladogs
post Jun 6 2018, 04:51 PM
Post#25



Posts: 386
Joined: 4-June 18



That's great. Thanks in advance

When I was setting this up, the one thing I couldn't get to work successfully was to take an automatic screenshot when the error occurred.
The image quality was never good enough to use so I gave up that idea.
Anders Ebro (Smiley Coder) had the same idea & he got that part to work

--------------------
nil illigetimi carborundem est
Go to the top of the page
 
JonSmith
post Jun 7 2018, 06:06 AM
Post#26



Posts: 3,691
Joined: 19-October 10



Ok, so I'll try to explain the benefit of logging the call stack.

I'll run it through step by step based on your screenshots about what it can add.

So first picture is of the error message displayed to the user. In terms of raw info like err number err description etc, then no. There is no extra benefit at this stage.

When you get to your second screenshot. Thats where the benefit comes in. Most of the errors in your shot seem quite specific and attached to button presses or things like that, so it wouldn't be too hard to track them down.

The nature of good programming however is small re-useable code, one potential drawback from that however is the more you split your code into smaller chunks that get re-used over and over is working out what was calling this code chunk that caused the error.
For example, I have a small function I use in pretty much every VBA project called ParentPath, its in a module called modFunctions. If this hit an error it wouldn't give me alot to go on that somewhere in my code it failed.

Now likely if ParentPath failed the proc that was using it would then fail too so I could perhaps piece that together, if you are lucky a filename would appear in the err desc, but what if its just a type 13 mismatch and its also in a proc thats called many times, perhaps its kicked off from looping through 100 files to process them or 1000 records to do something? Ok, so we now know we have a bad data type somewhere in one of the 100 files I loop through, but where, how do we find it?

A common tactic would be to go to the user and recreate the issue and then when it hits the error this time go to break mode and inspect. But if you compile your FE's you cannot go into break mode.
Ok so get the dev copy running and try and recreate the error and go into break mode. This can also mean often stepping through alot of code until you find the correct one.
Ooof what a mess. But ok, we tracked it down, but then the error occurs again. Turns out more than one file had bad data, lets go back into break mode and do some tracking again......


In my example I can see the entire callstack so I could instantly see that, for example, its the 53rd file and then any subsequent files without having to recreate anything with a user or on a dev copy. If I added a note within that callstack as part of the logging I can get even more rich information to get to the root cause immediately.

I can even use it with a troublesome user who isn't being very honest about things as its audit logging aswell as error logging.
'This information is missing! Your tool has done something wrong!' - No, look, the logs show you pressed the delete button at this time etc etc.

I'll post my class in a follow up so it doesn't clutter this message.
Go to the top of the page
 
JonSmith
post Jun 7 2018, 06:06 AM
Post#27



Posts: 3,691
Joined: 19-October 10



CODE
Option Explicit
'This class is used to log events, notes and errors to an XML file.

'******* REFERENCES REQUIRED*********
'* Microsoft XML, v3.0 required.
'************************************

'This is the document with all the logging in it.
Private objXDocMessageLog As New MSXML2.DOMDocument
Private objParentEventNode As MSXML2.IXMLDOMElement
Private objCurrentEventNode As MSXML2.IXMLDOMElement
Private objNoteNode As MSXML2.IXMLDOMElement
Private objErrNode As MSXML2.IXMLDOMElement
Private strLogFileName As String
Private strApplicationTitle As String


Public Property Get StackHasError() As Boolean
         '---------------------------------------------------------------------------------------
         '    Method: StackHasError
         '    Author: Jon Smith
         '      Date: 24/11/2017
         '   Purpose: Checks the node stack for errors.
         '   Returns: Returns true if anywhere done the call stack has an error logged.
         'Parameters:
         '---------------------------------------------------------------------------------------
         Dim objXDocErrorCheck As New MSXML2.DOMDocument
         'Load the XML of the current node, then we can try to find any node that is called "Error"
10       Set objXDocErrorCheck = New MSXML2.DOMDocument
20       objXDocErrorCheck.LoadXML objCurrentEventNode.XML
30       StackHasError = objXDocErrorCheck.SelectNodes("//Error").length > 0
End Property

Private Sub Class_Initialize()
         '---------------------------------------------------------------------------------------
         '    Method: Class_Initialize
         '    Author: Jon Smith
         '      Date: 24/11/2017
         '   Purpose: If a log for this day already exists it loads it up, if it doesn't creates a new XML for one.
         'Parameters:
         '---------------------------------------------------------------------------------------

         'Check to see if a log for today already exists
10       strApplicationTitle = CurrentDb.Properties("AppTitle").Value
          
30       strLogFileName = TempVars!ApplicationPath & "\Data\Users\Logs\" & Year(Date) & "\" & Format(Month(Date), "00") & "\" & strApplicationTitle & " - EventLog - " & Format(Date, "yyyyMMdd") & ".xml"
40       Call BuildFolders
50       If Dir(strLogFileName) = vbNullString Then
            'File doesn't exist so make the parent Events node.
60          Set objParentEventNode = objXDocMessageLog.createElement("Events")
70          objParentEventNode.setAttribute "Date", Format(Date, "yyyy-MM-dd")
80          Call objXDocMessageLog.appendChild(objParentEventNode)
90       Else
            'The log already exists so read the XML of it and select the Events node.
100         objXDocMessageLog.Load strLogFileName
110         Set objParentEventNode = objXDocMessageLog.SelectSingleNode("/Events")
120      End If
130      Set objCurrentEventNode = objParentEventNode
End Sub
Private Sub BuildFolders()
         '---------------------------------------------------------------------------------------
         '    Method: BuildFolders
         '    Author: Jon Smith
         '      Date: 04/12/2017
         '   Purpose: Builds the logging folders if they don't exist.
         'Parameters:
         '---------------------------------------------------------------------------------------
10       If Dir(TempVars!ApplicationPath & "\Data\Users\Logs\" & Year(Date), vbDirectory) = vbNullString Then MkDir (TempVars!ApplicationPath & "\Data\Users\Logs\" & Year(Date))
20       If Dir(TempVars!ApplicationPath & "\Data\Users\Logs\" & Year(Date) & "\" & Format(Month(Date), "00"), vbDirectory) = vbNullString Then MkDir (TempVars!ApplicationPath & "\Data\Users\Logs\" & Year(Date) & "\" & Format(Month(Date), "00"))
End Sub
Public Sub StartEvent(strEventName As String)
         '---------------------------------------------------------------------------------------
         '    Method: StartEvent
         '    Author: Jon Smith
         '      Date: 24/11/2017
         '   Purpose: This Creates a new event node as a child of the current event node.
         'Parameters:
         '            strEventName - Event name
         '---------------------------------------------------------------------------------------
      
         'The current Event node becomes the parent event node.
10       Set objParentEventNode = objCurrentEventNode

         'Create the new event node and add it to the XML
20       Set objCurrentEventNode = objXDocMessageLog.createElement("Event")
30       objCurrentEventNode.setAttribute "Username", Environ("Username")
40       Call objParentEventNode.appendChild(objCurrentEventNode)
50       objCurrentEventNode.setAttribute "EventName", strEventName
60       objCurrentEventNode.setAttribute "Time", Format(Now(), "HH:mm:ss")
End Sub
Public Sub EndEvent()
         '---------------------------------------------------------------------------------------
         '    Method: EndEvent
         '    Author: Jon Smith
         '      Date: 24/11/2017
         '   Purpose: This ends the current event. It just moves the parent node up one.
         'Parameters:
         '---------------------------------------------------------------------------------------
         'We now just want to move up one parent.
10       Set objCurrentEventNode = objCurrentEventNode.ParentNode
20       If Not objParentEventNode.nodeName = "Events" Then
30          Set objParentEventNode = objParentEventNode.ParentNode
40       End If
End Sub
Public Sub AddNote(strNote As String)
         '---------------------------------------------------------------------------------------
         '    Method: AddNote
         '    Author: Jon Smith
         '      Date: 24/11/2017
         '   Purpose: Adds a note to the current parent node
         'Parameters:
         '            strNote - The note to be saved
         '---------------------------------------------------------------------------------------
10       Set objNoteNode = objXDocMessageLog.createElement("Note")
20       objNoteNode.setAttribute "Time", Format(Now(), "HH:mm:ss")
30       objNoteNode.Text = strNote
40       Call objCurrentEventNode.appendChild(objNoteNode)
End Sub
Public Sub LogErrorMessage(lngErrNumber As Long, ByVal strErrDescription As String, strCallingProc As String, strModule As String, lngErrLine As Long, boolSupressMessage As Boolean, Optional strCustomErrorMessage As String, Optional boolAppendToRoot As Boolean = False)
         '---------------------------------------------------------------------------------------
         '    Method: LogErrorMessage
         '    Author: Jon Smith
         '      Date: 24/11/2017
         '   Purpose: Adds an error to the log. Displays a message if appropriate.
         'Parameters:
         '            lngErrNumber - The error number
         '            strErrDescription - The error description
         '            strCallingProc - The procedure that had an error
         '            strModule - The module the procedure was in
         '            lngErrLine - The error line
         '            boolSupressMessage - True to suppress any error message popups
         '            strCustomErrorMessage - A custom error message.
         '            boolAppendToRoot - True to add to the root node, false to add to current
         '---------------------------------------------------------------------------------------
          
10       Set objErrNode = objXDocMessageLog.createElement("Error")
20       objErrNode.setAttribute "ErrNum", lngErrNumber
30       objErrNode.setAttribute "ErrDesc", strErrDescription
40       objErrNode.setAttribute "ErrTime", Format(Now(), "HH:mm:ss:nn")
50       objErrNode.setAttribute "CallingProc", strCallingProc
60       objErrNode.setAttribute "Module", strModule
70       objErrNode.setAttribute "ErrLine", lngErrLine
80       objErrNode.setAttribute "Application", strApplicationTitle
90       objErrNode.setAttribute "Username", Environ("Username")
100      If boolAppendToRoot = True Then
110         Call objXDocMessageLog.SelectSingleNode("/Events").appendChild(objErrNode)
120      Else
130         Call objCurrentEventNode.appendChild(objErrNode)
140      End If
150      Call SaveLog
         'Display a message if appropriate
160      If boolSupressMessage = False Then
170         If strCustomErrorMessage = vbNullString Then
180            MsgBox "An error has occurred and will be logged, if this persists please contact the Development team for assistance", vbCritical, "Error"
190         Else
200            MsgBox strCustomErrorMessage, vbCritical, "Error"
210         End If
220      End If
End Sub

Public Sub SaveLog()
         '---------------------------------------------------------------------------------------
         '    Method: SaveLog
         '    Author: Jon Smith
         '      Date: 24/11/2017
         '   Purpose: Saves the log, simply writes the data to the text file, overwrites any existing data since the entire XML is already loaded into memory.
         'Parameters:
         '---------------------------------------------------------------------------------------
         Dim iFileNum As Integer
         ' next file number
10       iFileNum = FreeFile
20       Open strLogFileName For Output As #iFileNum
30       Print #iFileNum, objXDocMessageLog.XML
40       Close #iFileNum
End Sub

Private Sub Class_Terminate()
         '---------------------------------------------------------------------------------------
         '    Method: Class_Terminate
         '    Author: Jon Smith
         '      Date: 24/11/2017
         '   Purpose: Saves the log when the class is terminated
         'Parameters:
         '---------------------------------------------------------------------------------------
10       Call SaveLog
End Sub

This post has been edited by JonSmith: Jun 7 2018, 06:07 AM
Go to the top of the page
 
isladogs
post Jun 7 2018, 12:58 PM
Post#28



Posts: 386
Joined: 4-June 18



Jon
Many thanks for posting your code.
I haven't studied it yet but will build a test database in the next few days and try it out. Is that all the code I need?

QUOTE
When you get to your second screenshot. Thats where the benefit comes in. Most of the errors in your shot seem quite specific and attached to button presses or things like that, so it wouldn't be too hard to track them down.

The nature of good programming however is small re-useable code, one potential drawback from that however is the more you split your code into smaller chunks that get re-used over and over is working out what was calling this code chunk that caused the error.
For example, I have a small function I use in pretty much every VBA project called ParentPath, its in a module called modFunctions. If this hit an error it wouldn't give me alot to go on that somewhere in my code it failed.


Similar to my original comment about your screenshot, its difficult to determine the scope of a complex system just from a few screenshots.
The error log form I showed was a randomly selected extract from my development machine.
Inevitably I will get more errors during the development stage than is the case once a new version goes into production.
Some of those errors will recur whilst I'm fixing the issue

I also reuse code VERY extensively - many procedures are used in multiple database applications.
Partly because the parts most widely reused have been tested to death, those rarely cause errors but the system still allows me to track down all errors precisely with minimal effort.

The form allows me to filter in one or more ways:
a) date or date range
b) user id (staff)
c) item type - form / form module / report / report module / query / table / module / macro (rarely used)
d) item name
e) procedure
f) item number - particularly useful in forms with multiple uses e.g. several toggle buttons running different procedures

I can also look for patterns related to specific users / versions / screen resolutions etc.

As the error logs are automatically sent to me, I no longer have to rely on vague responses from some users (or no feedback at all).
It also means I can test on an ACCDB version rather the ACCDE at a remote site.

As I rarely visit (nor need to visit) any of my client sites, remote maintenance is an essential.
In fact I have several client (schools) that I have never visited in all the years they have used my apps

With one client school, the error logs proved what I had been saying for a couple of years - the problem was frequent network interruptions rather than my application

From your description, your system is very thorough and I'm sure it does everything you say.
However, I still haven't read anything that using call stacks can do that my system can't ... and it seems to me at the moment - just as easily
Perhaps testing will prove otherwise.

Once I've had a chance to test your code, I'll get back to you properly.
If I have any questions, I'll PM you if that's OK.




--------------------
nil illigetimi carborundem est
Go to the top of the page
 
JonSmith
post Jun 18 2018, 03:16 AM
Post#29



Posts: 3,691
Joined: 19-October 10



So I've eventually downloaded this vbWatchdog thing.
Wow, at first glance it certainly is very impressive. Extremely easy to implement in a project and gives extremely detailed information. Its way ahead of my logging and only the developer needs a licence for it. End users dont need anything installed.
I didn't know this was possible in VBA, I'm going to have to dive into this more.

I realise this topic hasn't been touched for a little while but wanted to update as there were some outstanding questions about that addin.
Go to the top of the page
 
2 Pages V < 1 2


Custom Search
RSSSearch   Top   Lo-Fi    20th August 2018 - 12:09 AM