Login or Sign Up to become a member!
LessThanDot Sit Logo

LessThanDot

Community Wiki

Less Than Dot is a community of passionate IT professionals and enthusiasts dedicated to sharing technical knowledge, experience, and assistance. Inside you will find reference materials, interesting technical discussions, and expert tips and commentary. Once you register for an account you will have immediate access to the forums and all past articles and commentaries.

LTD Social Sitings

Lessthandot twitter Lessthandot Linkedin Lessthandot friendfeed Lessthandot facebook Lessthandot rss

Note: Watch for social icons on posts by your favorite authors to follow their postings on these and other social sites.

Navigation

Google Ads

VBE: Adding Error Coding

From Wiki

Jump to: navigation, search

Please note that this is only lightly tested and could make a complete mess of your code.

See also: http://wiki.lessthandot.com/index.php?title=VBE:_Removing_Error_Coding

Some notes on adding error coding to procedures. The code requires a reference to Microsoft Visual Basic for Applications Extensibility 5.3.

It should insert something on the lines of:

vbaLine number Off | Hide | Select all
  1. Private Sub ACommand_Click()
  2. On Error GoTo Err_ACommand_Click
  3.  
  4. [PROCEDURE_BODY]
  5.    
  6. ''**INSERTED BY CODE 06/04/2012 00:31:42
  7. Exit_ACommand_Click:
  8.     Exit Sub
  9.  
  10. Err_ACommand_Click:
  11.     MsgBox Err.Description
  12.     LogError "ACommand_Click, " & Err.Number & ", " & Err.Description
  13.     Err.Clear
  14.     Resume Exit_ACommand_Click
  15.  
  16. End Sub

The code start here.

vbaLine number Off | Hide | Select all
  1. Sub LogError(strError)
  2. Const ForAppending = 8
  3. Dim sPath As String
  4. Dim fs As Object
  5. Dim ts As Object
  6.  
  7.     sPath = CurrentProject.Path
  8.    
  9.     Set fs = CreateObject("Scripting.FileSystemObject")
  10.     If fs.FileExists(sPath & "\ErrorLog.txt") = True Then
  11.         Set ts = fs.OpenTextFile(sPath & "\ErrorLog.txt", ForAppending)
  12.     Else
  13.         Set ts = fs.CreateTextFile(sPath & "\ErrorLog.txt")
  14.     End If
  15.     ts.WriteLine Now & " " & strError
  16.     ts.Close
  17. End Sub
  18.  
  19. Sub Main(DBPath As String, Optional DBPass As String = "")
  20. ''Microsoft Visual Basic for Applications Extensibility 5.3.
  21. Dim ap As New Access.Application
  22. Dim oCode As VBIDE.CodeModule
  23. Dim oVBE As VBIDE.VBComponents
  24. Dim pk As vbext_ProcKind
  25. Dim bSkipClassMods As Boolean
  26. Dim bSkipFormReportMods As Boolean
  27. Dim bSkipMods As Boolean
  28. Dim bAddErrCode As Boolean
  29. Dim sCodeName As String
  30. Dim sProcName As String
  31. Dim sProcType As String
  32. Dim ProcArray() As Variant
  33. Dim lProcStartLine As Long
  34. Dim lProcEndLine As Long
  35. Dim lStartLine As Long
  36. Dim lEndLine As Long
  37. Dim sLine As String
  38. Dim sFind As String
  39. Dim sErrLine As String
  40. Dim sErrCode As String
  41. Dim i
  42.  
  43.     ''Module Types
  44.     ''Class module                            VBIDE =   2 ; Access = 1
  45.     ''Form / Report (prefix form_ or report_) VBIDE = 100 ; Access = 1
  46.     ''Ordinary module                         VBIDE =   1 ; Access = 0
  47.     ''
  48.     ''VBA / Access : acClassModule = 1 ; acStandardModule = 0
  49.  
  50.     bSkipClassMods = False       '' Type 2
  51.     bSkipFormReportMods = False  '' Type 100
  52.     bSkipMods = False            '' Type 1
  53.  
  54.     ''Database to be updated
  55.     ap.Visible = True
  56.     ap.OpenCurrentDatabase DBPath, False, DBPass
  57.     Set oVBE = ap.VBE.ActiveVBProject.VBComponents
  58.  
  59.     ''Procarray 0 = Module name
  60.     ''          1 = Proc name
  61.     GetProcs oVBE, ProcArray
  62.  
  63.     For i = UBound(ProcArray, 2) To 0 Step -1
  64.         sCodeName = ProcArray(0, i)
  65.         sProcName = ProcArray(1, i)
  66.         bAddErrCode = True
  67.        
  68.         Set oCode = oVBE(sCodeName).CodeModule
  69.  
  70.         If (bSkipClassMods = True And oVBE(sCodeName).Type = 2) _
  71.             Or (bSkipFormReportMods = True And oVBE(sCodeName).Type = 100) _
  72.             Or (bSkipMods = True And oVBE(sCodeName).Type = 1) Then
  73.        
  74.             LogError sCodeName & ", " & sProcName & ", " & oVBE(sCodeName).Type
  75.        
  76.         Else
  77.  
  78.             'The line beginning sub, function etc
  79.             lProcStartLine = oCode.ProcBodyLine(sProcName, pk)
  80.            
  81.             ''NB Not procbodyline, count is counted from procstartline, which includes
  82.             ''the comments and blank lines before ProcBodyLine
  83.             lProcEndLine = oCode.ProcCountLines(sProcName, pk) + oCode.ProcStartLine(sProcName, pk)
  84.            
  85.             sLine = oCode.Lines(lProcStartLine, 1)
  86.            
  87.             If InStr(sLine, "Sub " & sProcName) = 0 _
  88.                 And InStr(sLine, "Function " & sProcName) = 0 Then
  89.                
  90.                 ''Something odd-ish
  91.                 LogError sCodeName & ", " & sProcName & ", " & sLine
  92.            
  93.             Else
  94.            
  95.                 sFind = "On Error GoTo"
  96.                
  97.                 ''Looking at various possibilities
  98.                 ''On Error GoTo <label>  - this is a deal-breaker, because it means that
  99.                 ''                         error handling has been added already.
  100.                 ''<comment>On Error GoTo - also a deal-breaker in this version
  101.                 ''On Error GoTo 0        - Not a problem
  102.                 ''On Error Resume        - Different pattern
  103.    
  104.                 lStartLine = lProcStartLine
  105.                 lEndLine = lProcEndLine
  106.        
  107.                 ''lSline and LEline are updated to find position
  108.                 If oCode.Find(sFind, lStartLine, 0, lEndLine, 0) Then
  109.                     ''line to change
  110.                     sLine = oCode.Lines(lStartLine, 1)
  111.                     If sLine <> "On Error GoTo 0" Then
  112.                         LogError sCodeName & ", " & sProcName & ", " & sLine
  113.                         bAddErrCode = False
  114.                     End If
  115.                 End If
  116.        
  117.                 If bAddErrCode = True Then
  118.                     ''Proc type, not avaible from pk, which classifies
  119.                     ''both sub and function as the same
  120.                    
  121.                     If InStr(sLine, "Sub " & sProcName) > 0 Then
  122.                         sProcType = "Sub"
  123.                     Else
  124.                         sProcType = "Function"
  125.                     End If
  126.                    
  127.                     sErrLine = "On Error GoTo Err_" & sProcName & vbCrLf
  128.                    
  129.                     sErrCode = vbCrLf & "''**INSERTED BY CODE " & Now() & vbCrLf _
  130.                         & "Exit_" & sProcName & ":" & vbCrLf _
  131.                         & vbTab & "Exit " & sProcType & vbCrLf & vbCrLf _
  132.                         & "Err_" & sProcName & ":" & vbCrLf _
  133.                         & vbTab & "MsgBox Err.Description" & vbCrLf _
  134.                         & vbTab & "LogError """ & sProcName _
  135.                             & ", "" &  Err.Number & "", "" & Err.Description" & vbCrLf _
  136.                         & vbTab & "Err.Clear" & vbCrLf _
  137.                         & vbTab & "Resume Exit_" & sProcName & vbCrLf
  138.                        
  139.                     oCode.InsertLines lProcEndLine - 1, sErrCode
  140.                     oCode.InsertLines lProcStartLine + 1, sErrLine
  141.                 End If
  142.             End If
  143.         End If
  144.     Next
  145.     ap.Quit
  146.     Set ap = Nothing
  147.    
  148. End Sub
  149.  
  150.  
  151. Function GetProcs(oVBE, ProcArray)
  152. ''A list of procedures
  153. Dim oCode As VBIDE.CodeModule
  154. Dim aModLines As Variant
  155. Dim sModText As String
  156. Dim sProcName As String
  157. Dim lLineCount As Long
  158. Dim lCodeObjectCounter As Long
  159. Dim pa As Long
  160. Dim lLine As Long
  161. Dim pk As vbext_ProcKind
  162.  
  163.     pa = -1 ''First run
  164.    
  165.     ''Yep, 1, not zero
  166.     For lCodeObjectCounter = 1 To oVBE.Count
  167.         Set oCode = oVBE(lCodeObjectCounter).CodeModule
  168.         lLineCount = oCode.CountOfLines
  169.        
  170.         lLine = 1
  171.         Do While lLine < lLineCount
  172.             sProcName = oCode.ProcOfLine(lLine, pk)
  173.             If sProcName <> "" Then
  174.                 ' Found a procedure. Get its details, and then skip
  175.                 ' to the end of the procedure.
  176.                 If pa = -1 Then
  177.                     pa = 0
  178.                     ReDim Preserve ProcArray(1, 0)
  179.                 Else
  180.                     pa = pa + 1
  181.                     ReDim Preserve ProcArray(1, pa)
  182.                 End If
  183.                 ProcArray(0, pa) = oCode.Name
  184.                 ''Proc name
  185.                 ProcArray(1, pa) = oCode.ProcOfLine(lLine, pk)
  186.                 lLine = lLine + oCode.ProcCountLines(sProcName, pk)
  187.             Else
  188.                 ' This line has no procedure, so go to the next line.
  189.                 lLine = lLine + 1
  190.             End If
  191.         Loop
  192.        
  193.     Next
  194.  
  195. End Function

837 Rating: 2.7/5 (7 votes cast)

Retrieved from "http://wiki.lessthandot.com/index.php/VBE:_Adding_Error_Coding"

Powered by MediaWiki GNU Free Documentation License 1.2
Valid XHTML | Valid CSS