Login or Sign Up to become a member!
LessThanDot Site 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 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

Difference between revisions of "VBE: Removing Error Coding"

From Wiki

Jump to: navigation, search
(New page: Here are some notes on removing standard error coding. This is generally in the form: <code vba>Private Sub ACommand_Click() On Error GoTo Err_ACommand_Click [PROCEDURE_BODY] Exit_AComm...)
(No difference)

Revision as of 23:40, 4 April 2012

Here are some notes on removing standard error coding. This is generally in the form:

  1. Private Sub ACommand_Click()
  2. On Error GoTo Err_ACommand_Click
  3.  
  4. [PROCEDURE_BODY]
  5.  
  6. Exit_ACommand_Click:
  7.    Exit Sub
  8.  
  9. Err_ACommand_Click:
  10.    MsgBox Err.Description
  11.    Resume Exit_ACommand_Click
  12.  
  13. End Sub

After running the code below, there is a reasonable chance that you will end up with something like this:

  1. Private Sub ACommand_Click()
  2. ''**: On Error GoTo Err_ACommand_Click
  3.  
  4. [PROCEDURE_BODY]
  5.  
  6. ''**Exit_ACommand_Click:
  7. ''**   Exit Sub
  8. ''**
  9. ''**Err_ACommand_Click:
  10. ''**   MsgBox Err.Description
  11. ''**   Resume Exit_ACommand_Click
  12. ''**
  13. End Sub

It should not be too difficult to modify the code to change the wizard error coding to something that suits you better or to include the name of the procedure in the error message.

  1. Sub Main(DBPath As String, Optional DBPass As String = "")
  2. ''This is not suitable for running unattended or in the same
  3. ''database as the code to be modified. It is only very lightly
  4. ''tested and includes quite a few rigid assumption.
  5. Dim ap As New Access.Application
  6. Dim oVBE As Object
  7. Dim mdl As Object
  8. Dim ProcArray()
  9. Dim sFind As String
  10. Dim lSLine As Long
  11. Dim lELine As Long
  12. Dim lEnd As Long
  13. Dim sLine As String
  14. Dim r As Long
  15. Dim i, j
  16.    
  17.     ''Database to be updated
  18.     ap.Visible = True
  19.     ap.OpenCurrentDatabase DBPath, False, DBPass
  20.        
  21.     ''Code project including forms and class modules
  22.     Set oVBE = ap.VBE.ActiveVBProject.VBComponents
  23.  
  24.     ''An  array of procedures to change
  25.     GetErrProcs oVBE, ProcArray
  26.    
  27.     ''ProcArray, 2 is the procedure name
  28.     For i = 0 To UBound(ProcArray, 2)
  29.         ''ProcArray(0, i) is the module name
  30.         Set mdl = oVBE(ProcArray(0, i)).CodeModule
  31.        
  32.         ''The list returned is of modules containing this line
  33.         sFind = "On Error GoTo Err_" & ProcArray(1, i)
  34.        
  35.         'The line beginning sub, function etc
  36.         lSLine = mdl.ProcBodyLine(ProcArray(1, i), r)
  37.        
  38.         ''NB Not procbodyline, count is counted from procstartline, which includes
  39.         ''the comments and blank lines before ProcBodyLine
  40.         lELine = (mdl.ProcCountLines(ProcArray(1, i), r) + mdl.ProcStartLine(ProcArray(1, i), r))
  41.        
  42.         ''lSline and LEline are updated to find position
  43.         If mdl.Find(sFind, lSLine, 0, lELine, 0) Then
  44.            
  45.             ''line to change
  46.             sLine = mdl.Lines(lSLine, 1)
  47.            
  48.             ''Skip previous run
  49.             If Left(sLine, 4) <> "''**" Then
  50.                 ''Just in case this line is a combination of two lines
  51.                If InStr(1, sLine, ": " & sFind) > 0 Then
  52.                     sLine = Replace(sLine, ": " & sFind, " ''**" & ": " & sFind)
  53.                 Else
  54.                     sLine = Replace(sLine, sFind, " ''**" & sFind)
  55.                 End If
  56.                 ''Debug.Print sLine
  57.                 ''Stop
  58.                
  59.                 ''Comment line out in a reversible way
  60.                 ''Find & Replace on code will easily replace ''**
  61.                 mdl.ReplaceLine lSLine, sLine
  62.             End If
  63.         End If
  64.    
  65.         ''This is the start of the standard error block inserted by add-ins
  66.         sFind = "Exit_" & ProcArray(1, i) & ":"
  67.         lSLine = mdl.ProcBodyLine(ProcArray(1, i), r)
  68.         lELine = (mdl.ProcCountLines(ProcArray(1, i), r) + mdl.ProcStartLine(ProcArray(1, i), r))
  69.         ''Last line but one for the procedure
  70.         lEnd = (mdl.ProcCountLines(ProcArray(1, i), r) + mdl.ProcStartLine(ProcArray(1, i), r)) - 2
  71.        
  72.         If mdl.Find(sFind, lSLine, 0, lELine, 0) Then
  73.             ''lEline is no use here because it is updated by find.
  74.             ''This comments out all lines from the Exit_ label
  75.             ''to the last line.
  76.             For j = lSLine To lEnd
  77.                 If Left(mdl.Lines(j, 1), 4) <> "''**" Then
  78.                     sLine = "''**" & mdl.Lines(j, 1)
  79.                     ''Debug.Print sLine
  80.                     ''Stop
  81.                     mdl.ReplaceLine j, sLine
  82.                 End If
  83.             Next
  84.         End If
  85.  
  86.     Next
  87. End Sub
  88.  
  89. Function GetErrProcs(oVBE, ProcArray)
  90. ''A list of procedures with error coding
  91. Dim mdl As Object
  92. Dim aModLines As Variant
  93. Dim sModText As String
  94. Dim sFind As String
  95. Dim lELine As Long
  96. Dim i, j
  97. Dim k As Long, r As Long
  98.  
  99.  
  100.     j = -1 ''First run
  101.     sFind = "On Error GoTo Err_"
  102.    
  103.     For i = 1 To oVBE.Count
  104.    
  105.         Set mdl = oVBE(i).CodeModule
  106.         lELine = mdl.CountOfLines
  107.        
  108.         If lELine > 2 Then
  109.             sModText = mdl.Lines(1, lELine)
  110.        
  111.             If InStr(sModText, sFind) > 0 Then
  112.                 aModLines = Split(sModText, vbCrLf)
  113.                
  114.                 For k = 0 To UBound(aModLines)
  115.                     If InStr(aModLines(k), sFind) > 0 Then
  116.                         If j = -1 Then
  117.                             j = 0
  118.                             ReDim Preserve ProcArray(1, 0)
  119.                         Else
  120.                             j = j + 1
  121.                             ReDim Preserve ProcArray(1, j)
  122.                         End If
  123.                         ProcArray(0, j) = mdl.Name
  124.                         ProcArray(1, j) = mdl.ProcOfLine(k, r)
  125.                     End If
  126.                 Next
  127.             End If
  128.         End If
  129.     Next
  130.  
  131. End Function

836 Rating: 3.0/5 (44 votes cast)