插件下载地址（请下载最新版v1.0.5）：

http://code.google.com/p/vsaddin/downloads

安装方法：
1.点击菜单“工程-引用”，选择这个dll
2.然后点击菜单“外接程序-外接程序管理器”，选择“Insert Error Hand”，把右下角两个框框都勾起来
3.这样你的菜单“外接程序”中就会多出“Insert Error Hand”这一项

使用方法：
将要处理的代码编辑窗口打开，然后点击菜单“外接程序-Insert Error Hand”

ps：插件会只会处理已经打开的代码编辑窗口

主要代码如下：

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '描述：VB6 IDE <a href="https://www.jb51.cc/tag/hanshu/" target="_blank" class="keywords">函数</a>过程<a href="https://www.jb51.cc/tag/cuowu/" target="_blank" class="keywords">错误</a>处理<a href="https://www.jb51.cc/tag/daima/" target="_blank" class="keywords">代码</a><a href="https://www.jb51.cc/tag/tianjia/" target="_blank" class="keywords">添加</a> '作者：sysdzw '邮箱：sysdzw@163.com QQ：171977759 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '<a href="https://www.jb51.cc/tag/xiugai/" target="_blank" class="keywords">修改</a>历史(有对<a href="https://www.jb51.cc/tag/daima/" target="_blank" class="keywords">代码</a><a href="https://www.jb51.cc/tag/xiugai/" target="_blank" class="keywords">修改</a>的请在下面<a href="https://www.jb51.cc/tag/zengjia/" target="_blank" class="keywords">增加</a>记录并且发送至邮箱sysdzw@163.com) '-------------------------------------------------------------------------- '日期 <a href="https://www.jb51.cc/tag/xiugai/" target="_blank" class="keywords">修改</a>者 版本 说明 '----------------------------------------------------------------------------- '2010-12-1 sysdzw v1.0.1 初版 '2010-12-2 sysdzw v1.0.2 改进了如果过程中<a href="https://www.jb51.cc/tag/yonghu/" target="_blank" class="keywords">用户</a>已经做了<a href="https://www.jb51.cc/tag/cuowu/" target="_blank" class="keywords">错误</a>处理就不再处理 ' v1.0.3 <a href="https://www.jb51.cc/tag/zengjia/" target="_blank" class="keywords">增加</a>了对Property过程的<a href="https://www.jb51.cc/tag/zhichi/" target="_blank" class="keywords">支持</a> '2010-12-3 sysdzw v1.0.4 修正了在过程的声明参数为多行情况下时处理发生<a href="https://www.jb51.cc/tag/cuowu/" target="_blank" class="keywords">错误</a> ' v1.0.5 <a href="https://www.jb51.cc/tag/zengjia/" target="_blank" class="keywords">增加</a>了对<a href="https://www.jb51.cc/tag/daima/" target="_blank" class="keywords">代码</a>窗口监视，使得<a href="https://www.jb51.cc/tag/daima/" target="_blank" class="keywords">代码</a>一发生变动即处理 '----------------------------------------------------------------------------- Option Explicit Public FormDisplayed As Boolean Public VBInstance As VBIDE.VBE Dim mcbMenuCommandBar As Office.CommandBarControl Public WithEvents MenuHandler As CommandBarEvents 'command bar event handler 'strMethodName <a href="https://www.jb51.cc/tag/fangfa/" target="_blank" class="keywords">方法</a>名 'strType 类型，为Sub或Function 'ojbCodeModel <a href="https://www.jb51.cc/tag/daima/" target="_blank" class="keywords">代码</a>窗口，用于检索<a href="https://www.jb51.cc/tag/fangfa/" target="_blank" class="keywords">方法</a>的行号行数 Private Sub dealMethod(ByVal strMethodName$,ByVal strType$,ojbCodeModel As CodeModule) On Error GoTo ErrHand Dim lngFirstProcLine&,lngFirstBodyLine&,lngProcLinesCount& Dim lngCurrentLine& lngFirstProcLine = ojbCodeModel.ProcStartLine(strMethodName,vbext_pk_Proc) '整个过程的第一行，比如过程前的注释的地方，适用于<a href="https://www.jb51.cc/tag/tianjia/" target="_blank" class="keywords">添加</a><a href="https://www.jb51.cc/tag/hanshu/" target="_blank" class="keywords">函数</a>注释 lngFirstBodyLine = ojbCodeModel.ProcBodyLine(strMethodName,vbext_pk_Proc) '过程<a href="https://www.jb51.cc/tag/daima/" target="_blank" class="keywords">代码</a>的第一行，一般就是过程的声明 lngProcLinesCount = ojbCodeModel.ProcCountLines(strMethodName,vbext_pk_Proc) '过程的<a href="https://www.jb51.cc/tag/daima/" target="_blank" class="keywords">代码</a>数 '如果整个过程中没有"On Error GoTo/Resume xxx"语句则在声明的下一行<a href="https://www.jb51.cc/tag/tianjia/" target="_blank" class="keywords">添加</a>"On Error GoTo ErrHand"，如果<a href="https://www.jb51.cc/tag/yonghu/" target="_blank" class="keywords">用户</a>自己处理了那么则<a href="https://www.jb51.cc/tag/tuichu/" target="_blank" class="keywords">退出</a> If Not isMatchReg(ojbCodeModel.Lines(lngFirstProcLine,lngProcLinesCount),"^ *?On Error (?:GoTo|Resume) *?'?") Then lngCurrentLine = lngFirstBodyLine Do If Right(ojbCodeModel.Lines(lngCurrentLine,1),1) <> "_" Then '由于有些声明是分多行写的，所以要找到最右边不是“_”的行号 ojbCodeModel.InsertLines lngCurrentLine + 1,vbTab & "On Error GoTo ErrHand" & vbCrLf lngProcLinesCount = lngProcLinesCount + 2 Exit Do End If lngCurrentLine = lngCurrentLine + 1 Loop '如果没有"ErrHand:"则在"End Sub/Funtion"前一行<a href="https://www.jb51.cc/tag/tianjia/" target="_blank" class="keywords">添加</a>"ErrHand:"等 If Not isMatchReg(ojbCodeModel.Lines(lngFirstProcLine,"^^ *?ErrHand: *?'?.*?") Then '查找"End Sub/Funtion"所在的行 lngCurrentLine = lngFirstProcLine + lngProcLinesCount - 1 Do If isMatchReg(ojbCodeModel.Lines(lngCurrentLine,"^ *?End " & strType & " *?'?") Then '找到了"End Sub/Funtion"所在的行，开始在前面<a href="https://www.jb51.cc/tag/tianjia/" target="_blank" class="keywords">添加</a>"ErrHand:"等 ojbCodeModel.InsertLines lngCurrentLine,vbCrLf & vbTab & "Exit " & strType & vbCrLf & _ "ErrHand:" & vbCrLf & _ vbTab & "Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> ""Error Number: "" & vbTab & Err.Number & vbCrLf & ""Error Description: "" & vbTab & Err.Description & vbCrLf & ""Error " & strType & ": "" & vbTab & """ & strMethodName & """,vbExclamation" Exit Do End If lngCurrentLine = lngCurrentLine - 1 Loop End If End If Exit Sub ErrHand: Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "Error Number: " & vbTab & Err.Number & vbCrLf & "Error Description: " & vbTab & Err.Description & vbCrLf & "Error Sub: " & vbTab & "dealMethod" & vbCrLf & _ "Arguments: " & vbTab & "strMethodName = " & strMethodName & "; strType = " & strType,vbExclamation End Sub 'strPropertyName <a href="https://www.jb51.cc/tag/shuxing/" target="_blank" class="keywords">属性</a>名 'strType 类型，为Property Set/Let/Get 'ojbCodeModel <a href="https://www.jb51.cc/tag/daima/" target="_blank" class="keywords">代码</a>窗口，用于检索<a href="https://www.jb51.cc/tag/fangfa/" target="_blank" class="keywords">方法</a>的行号行数 Private Sub dealProperty(ByVal strPropertyName$,ojbCodeModel As CodeModule) On Error GoTo ErrHand Dim strData$,lngCurrentLine& Dim lngPropertyFirstLine&,strPropertyCode$ strData = ojbCodeModel.Lines(1,ojbCodeModel.CountOfLines) lngPropertyFirstLine = regGetStr1Line(strData,"^(?:public|private)? *?" & strType & " " & strPropertyName & "/(?") strPropertyCode = regGetStr1(strData,"^(?:public|private)? *?" & strType & " " & strPropertyName & "[/s/S]+?^ *?End Property *?'?") '如果整个过程中没有"On Error GoTo/Resume xxx"语句则在声明的下一行<a href="https://www.jb51.cc/tag/tianjia/" target="_blank" class="keywords">添加</a>"On Error GoTo ErrHand"，如果<a href="https://www.jb51.cc/tag/yonghu/" target="_blank" class="keywords">用户</a>自己处理了那么则<a href="https://www.jb51.cc/tag/tuichu/" target="_blank" class="keywords">退出</a> If Not isMatchReg(strPropertyCode,"^ *?On Error (?:GoTo|Resume) *?'?") Then lngCurrentLine = lngPropertyFirstLine Do If Right(ojbCodeModel.Lines(lngCurrentLine,vbTab & "On Error GoTo ErrHand" & vbCrLf Exit Do End If lngCurrentLine = lngCurrentLine + 1 Loop '如果没有"ErrHand:"则在"End Property"前一行<a href="https://www.jb51.cc/tag/tianjia/" target="_blank" class="keywords">添加</a>"ErrHand:"等 If Not isMatchReg(strPropertyCode,"^^ *?ErrHand: *?'?.*?") Then '查找"End Property"所在的行 lngCurrentLine = lngPropertyFirstLine + 3 Do If isMatchReg(ojbCodeModel.Lines(lngCurrentLine,"^ *?End Property *?'?") Then '找到了"End Property"所在的行，开始在前面<a href="https://www.jb51.cc/tag/tianjia/" target="_blank" class="keywords">添加</a>"ErrHand:"等 ojbCodeModel.InsertLines lngCurrentLine,vbCrLf & vbTab & "Exit Property" & vbCrLf & _ "ErrHand:" & vbCrLf & _ vbTab & "Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> ""Error Number: "" & vbTab & Err.Number & vbCrLf & ""Error Description: "" & vbTab & Err.Description & vbCrLf & ""Error Property: "" & vbTab & """ & Right(strType,3) & " " & strPropertyName & """,vbExclamation" Exit Do End If lngCurrentLine = lngCurrentLine + 1 Loop End If End If Exit Sub ErrHand: Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "Error Number: " & vbTab & Err.Number & vbCrLf & "Error Description: " & vbTab & Err.Description & vbCrLf & "Error Sub: " & vbTab & "dealProperty" & vbCrLf & _ "Arguments: " & vbTab & "strPropertyName = " & strPropertyName & "; strType = " & strType,vbExclamation End Sub Private Sub AddinInstance_OnBeginShutdown(custom() As Variant) On Error GoTo ErrHand frmWatch.tmrWatch.Enabled = False Unload frmWatch Exit Sub ErrHand: Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "Error Number: " & vbTab & Err.Number & vbCrLf & "Error Description: " & vbTab & Err.Description & vbCrLf & "Error Sub: " & vbTab & "AddinInstance_OnBeginShutdown",vbExclamation End Sub 'this event fires when the menu is clicked in the IDE Private Sub MenuHandler_Click(ByVal CommandBarControl As Object,handled As Boolean,CancelDefault As Boolean) On Error GoTo ErrHand Dim objCodePane As CodePane ' frmWatch.Show 1 frmWatch.tmrWatch.Enabled = False For Each objCodePane In VBInstance.CodePanes dealCodeModule objCodePane.CodeModule Next frmWatch.tmrWatch.Enabled = True Exit Sub ErrHand: Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "Error Number: " & vbTab & Err.Number & vbCrLf & "Error Description: " & vbTab & Err.Description & vbCrLf & "Error Sub: " & vbTab & "MenuHandler_Click",vbExclamation End Sub Public Sub dealCodeModule(ByVal ojbCodeModule As CodeModule) On Error GoTo ErrHand ' On Error GoTo ErrHand Dim strData$,strD<a href="https://www.jb51.cc/tag/atan/" target="_blank" class="keywords">atan</a>ew$ Dim reg As Object Dim matchs As Object,match As Object Dim lngPropertyFirstLine&,strPropertyCode$ Set reg = CreateObject("vbscript.regexp") reg.Global = True reg.IgnoreCase = True reg.MultiLine = True reg.Pattern = "^(?:public|private)? *?(sub|function|Property (?:Let|Set|Get)) +?(/w+)/(?" '有<a href="https://www.jb51.cc/tag/daima/" target="_blank" class="keywords">代码</a>时再处理 If ojbCodeModule.CountOfLines > 0 Then strData = ojbCodeModule.Lines(1,ojbCodeModule.CountOfLines) Set matchs = reg.Execute(strData) For Each match In matchs If InStr(match.SubMatches(0),"Property") > 0 Then 'dealProperty类型 dealProperty match.SubMatches(1),match.SubMatches(0),ojbCodeModule ',lngPropertyFirstLine,strPropertyCode Else 'Sub 或 Function dealMethod match.SubMatches(1),ojbCodeModule End If Next End If Exit Sub ErrHand: Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "Error Number: " & vbTab & Err.Number & vbCrLf & "Error Description: " & vbTab & Err.Description & vbCrLf & "Error Sub: " & vbTab & "dealCodeModule",vbExclamation End Sub '------------------------------------------------------ 'this method adds the Add-In to VB '------------------------------------------------------ Private Sub AddinInstance_OnConnection(ByVal Application As Object,ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode,ByVal AddInInst As Object,custom() As Variant) On Error GoTo ErrHand 'save the vb instance Set VBInstance = Application 'this is a good place to set a breakpoint and 'test var<a href="https://www.jb51.cc/tag/IoU/" target="_blank" class="keywords">IoU</a>s addin objects,properties and methods If ConnectMode = ext_cm_External Then 'Used by the wizard toolbar to start this wizard Else Set mcbMenuCommandBar = AddToAddInCommandBar("Insert Error Hand") 'sink the event Set Me.MenuHandler = VBInstance.Events.CommandBarEvents(mcbMenuCommandBar) End If If ConnectMode = ext_cm_AfterStartup Then If GetSetting(App.Title,"Settings","DisplayOnConnect","0") = "1" Then 'set this to display the form on connect End If End If Set frmWatch.VBInstance = VBInstance Set frmWatch.Connect = Me Load frmWatch frmWatch.tmrWatch.Enabled = True ' Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> VBInstance.CodePanes.Count Exit Sub ErrHand: Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "Error Number: " & vbTab & Err.Number & vbCrLf & "Error Description: " & vbTab & Err.Description & vbCrLf & "Error Sub: " & vbTab & "AddinInstance_OnConnection",vbExclamation End Sub '------------------------------------------------------ 'this method removes the Add-In from VB '------------------------------------------------------ Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode,custom() As Variant) On Error GoTo ErrHand 'delete the command bar entry mcbMenuCommandBar.Delete 'shut down the Add-In If FormDisplayed Then SaveSetting App.Title,"1" FormDisplayed = False Else SaveSetting App.Title,"0" End If Exit Sub ErrHand: Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "Error Number: " & vbTab & Err.Number & vbCrLf & "Error Description: " & vbTab & Err.Description & vbCrLf & "Error Sub: " & vbTab & "AddinInstance_OnDisconnection",vbExclamation End Sub Function AddToAddInCommandBar(sCaption As String) As Office.CommandBarControl On Error GoTo ErrHand Dim cbMenuCommandBar As Office.CommandBarControl 'command bar object Dim cbMenu As Object 'see if we can find the Add-Ins menu Set cbMenu = VBInstance.CommandBars("Add-Ins") If cbMenu Is Nothing Then 'not available so we fail Exit Function End If 'add it to the command bar Set cbMenuCommandBar = cbMenu.Controls.Add(1) 'set the caption cbMenuCommandBar.Caption = sCaption Set AddToAddInCommandBar = cbMenuCommandBar Exit Function ErrHand: Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "Error Number: " & vbTab & Err.Number & vbCrLf & "Error Description: " & vbTab & Err.Description & vbCrLf & "Error Sub: " & vbTab & "AddToAddInCommandBar",vbExclamation End Function '测试正则是否匹配 Private Function isMatchReg(strData$,strPattern$) As Boolean On Error GoTo ErrHand Dim reg As Object Set reg = CreateObject("vbscript.regexp") reg.Global = True reg.IgnoreCase = True reg.MultiLine = True reg.Pattern = strPattern isMatchReg = reg.test(strData) Exit Function ErrHand: Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "Error Number: " & vbTab & Err.Number & vbCrLf & "Error Description: " & vbTab & Err.Description & vbCrLf & "Error Sub: " & vbTab & "isMatchReg",vbExclamation End Function '得到正则括号的第一个匹配项 Private Function regGetStr1(strData$,strPattern$) As String On Error GoTo ErrHand Dim reg As Object Dim matchs As Object,match As Object Set reg = CreateObject("vbscript.regexp") reg.Global = False reg.IgnoreCase = True reg.MultiLine = True reg.Pattern = strPattern Set matchs = reg.Execute(strData$) If matchs.Count >= 1 Then regGetStr1 = matchs(0) End If Exit Function ErrHand: Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "Error Number: " & vbTab & Err.Number & vbCrLf & "Error Description: " & vbTab & Err.Description & vbCrLf & "Error Sub: " & vbTab & "regGetStr1",vbExclamation End Function '得到正则括号的第一个匹配项所在的行 Private Function regGetStr1Line(ByVal strData$,strPattern$) As Long On Error GoTo ErrHand Dim reg As Object Dim matchs As Object,match As Object Set reg = CreateObject("vbscript.regexp") reg.Global = False reg.IgnoreCase = True reg.MultiLine = True reg.Pattern = strPattern Set matchs = reg.Execute(strData$) If matchs.Count >= 1 Then regGetStr1Line = UBound(Split(Left(strData,matchs(0).FirstIndex + 1),vbCrLf)) + 1 End If Exit Function ErrHand: Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "Error Number: " & vbTab & Err.Number & vbCrLf & "Error Description: " & vbTab & Err.Description & vbCrLf & "Error Sub: " & vbTab & "regGetStr1Line",vbExclamation End Function '得到正则的数组 Private Function regResult(strData$,strPattern$) On Error GoTo ErrHand Dim reg As Object,s$,i% Dim matchs As Object,match As Object Set reg = CreateObject("vbscript.regexp") reg.Global = True reg.IgnoreCase = True reg.MultiLine = True reg.Pattern = strPattern Set matchs = reg.Execute(strData$) For i = 0 To matchs(0).SubMatches.Count - 1 s = s & matchs(0).SubMatches(i) & "_split_" Next If s <> "" Then s = Left(s,Len(s) - 7) regResult = Split(s,"_split_") Exit Function ErrHand: Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "Error Number: " & vbTab & Err.Number & vbCrLf & "Error Description: " & vbTab & Err.Description & vbCrLf & "Error Function: " & vbTab & "regResult",vbExclamation End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '<a href="https://www.jb51.cc/tag/gongneng/" target="_blank" class="keywords">功能</a>：根据所给<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a>名和<a href="https://www.jb51.cc/tag/neirong/" target="_blank" class="keywords">内容</a>直接写<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a> '<a href="https://www.jb51.cc/tag/hanshu/" target="_blank" class="keywords">函数</a>名：writeToFile '入口参数(如下)： ' strFileName 所给的<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a>名； ' strContent 要输入到上述<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a>的字符串 ' isCover 是否覆盖该<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a>，默认为覆盖 '返回值：True或False，成功则返回前者，否则返回后者 '备注：sysdzw 于 2007-5-2 提供 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Function writeToFile(ByVal strFileName$,ByVal strContent$,Optional isCover As Boolean = True) As Boolean On Error GoTo ErrHand Dim fileHandl% fileHandl = FreeFile If isCover Then Open strFileName For Output As #fileHandl Else Open strFileName For Append As #fileHandl End If Print #fileHandl,strContent Close #fileHandl writeToFile = True Exit Function ErrHand: Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "Error Number: " & vbTab & Err.Number & vbCrLf & "Error Description: " & vbTab & Err.Description & vbCrLf & "Error Sub: " & vbTab & "writeToFile",vbExclamation End Function

v1.0.6设置窗口预览：