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: Removing 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/VBE:_Adding_Error_Coding

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

vbaLine number Off | Hide | Select all
  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:

vbaLine number Off | Hide | Select all
  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.

vbaLine number Off | Hide | Select all
  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 sProcName As String
  10. Dim sFind As String
  11. Dim lSLine As Long
  12. Dim lELine As Long
  13. Dim lEnd As Long
  14. Dim sLine As String
  15. Dim r As Long
  16. Dim i, j
  17.    
  18.     ''Database to be updated
  19.     ap.Visible = True
  20.     ap.OpenCurrentDatabase DBPath, False, DBPass
  21.        
  22.     ''Code project including forms and class modules
  23.     Set oVBE = ap.VBE.ActiveVBProject.VBComponents
  24.  
  25.     ''The list returned is of modules containing this line
  26.     sFind = "On Error GoTo Err_" '' & sProcName
  27.    
  28.     ''An  array of procedures to change
  29.     GetErrProcs oVBE, ProcArray, sFind
  30.    
  31.     ''ProcArray, 2 is the procedure name
  32.     For i = 0 To UBound(ProcArray, 2)
  33.         ''ProcArray(0, i) is the module name
  34.         Set mdl = oVBE(ProcArray(0, i)).CodeModule
  35.        
  36.         'The line beginning sub, function etc
  37.         sProcName = ProcArray(1, i)
  38.         lSLine = mdl.ProcBodyLine(sProcName, r)
  39.        
  40.         ''NB Not procbodyline, count is counted from procstartline, which includes
  41.         ''the comments and blank lines before ProcBodyLine
  42.         lELine = (mdl.ProcCountLines(sProcName, r) + mdl.ProcStartLine(sProcName, r))
  43.        
  44.         ''lSline and LEline are updated to find position
  45.         If mdl.Find(sFind & sProcName, lSLine, 0, lELine, 0) Then
  46.            
  47.             ''line to change
  48.             sLine = mdl.Lines(lSLine, 1)
  49.            
  50.             ''Skip previous run
  51.             If Left(sLine, 4) <> "''**" Then
  52.                 ''Just in case this line is a combination of two lines
  53.                If InStr(1, sLine, ": " & sFind & sProcName) > 0 Then
  54.                     sLine = Replace(sLine, ": " & sFind & sProcName, " ''**" & ": " & sFind & sProcName)
  55.                 Else
  56.                     sLine = Replace(sLine, sFind & sProcName, " ''**" & sFind & sProcName)
  57.                 End If
  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_" & sProcName & ":"
  67.         lSLine = mdl.ProcBodyLine(sProcName, r)
  68.         lELine = (mdl.ProcCountLines(sProcName, r) + mdl.ProcStartLine(sProcName, r))
  69.         ''Last line but one for the procedure
  70.         lEnd = (mdl.ProcCountLines(sProcName, r) + mdl.ProcStartLine(sProcName, 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, sFind)
  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 lELine As Long
  95. Dim i, j
  96. Dim k As Long, r As Long
  97.  
  98.  
  99.     j = -1 ''First run
  100.     sFind = "On Error GoTo Err_"
  101.    
  102.     For i = 1 To oVBE.Count
  103.    
  104.         Set mdl = oVBE(i).CodeModule
  105.         lELine = mdl.CountOfLines
  106.        
  107.         If lELine > 2 Then
  108.             sModText = mdl.Lines(1, lELine)
  109.        
  110.             If InStr(sModText, sFind) > 0 Then
  111.                 aModLines = Split(sModText, vbCrLf)
  112.                
  113.                 For k = 0 To UBound(aModLines)
  114.                     If InStr(aModLines(k), sFind) > 0 Then
  115.                         If j = -1 Then
  116.                             j = 0
  117.                             ReDim Preserve ProcArray(1, 0)
  118.                         Else
  119.                             j = j + 1
  120.                             ReDim Preserve ProcArray(1, j)
  121.                         End If
  122.                         ProcArray(0, j) = mdl.Name
  123.                         ProcArray(1, j) = mdl.ProcOfLine(k, r)
  124.                     End If
  125.                 Next
  126.             End If
  127.         End If
  128.     Next
  129.  
  130. End Function

836 Rating: 3.7/5 (15 votes cast)

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

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