简单的 On Error goto错误处理语句问题

Question

有下面这样一个过程
Dim pFeaCursor As IFeatureCursor
        Dim pFeature As IFeature
        Dim pGeometry As IGeometry
        
        Set pFeaCursor = pFcls.Search(pSpatialFlt, False)
        Set pFeature = pFeaCursor.NextFeature
        Do While Not pFeature Is Nothing
            Set pGeometry = TopoDifference(pFeature.ShapeCopy, pUpdatePolygon)
            
On Error GoTo NextFeature
            If pGeometry Is Nothing Or pGeometry.IsEmpty Then
                pFeature.Delete
            Else
                Set pFeature.Shape = pGeometry
                pFeature.store       '第一次这里出错的时候，会运行到 NextFeature行，但是第二次如果再遇到错误就直接跳出过程了，查看了一下网上资料，说是On error goto语句只在本次过程内第一次遇到错误有效，第二次遇到错误就无效了，这样应该怎么处理，让他每次遇到错误都运行到 NextFeature行？
            End If
            
            SetSysProValue i
            i = i + 1
            DoEvents
            
NextFeature:
            Set pFeature = pFeaCursor.NextFeature
        Loop
        
NextLayer:
        rs.MoveNext
    Loop

Answer 1

怎么有两个 Loop ？ 你是否想要这样的流程：        Dim pFeaCursor As IFeatureCursor 
        Dim pFeature As IFeature 
        Dim pGeometry As IGeometry 
         
        Set pFeaCursor = pFcls.Search(pSpatialFlt, False) 
        Set pFeature = pFeaCursor.NextFeature 
        Do While Not pFeature Is Nothing 
            Set pGeometry = TopoDifference(pFeature.ShapeCopy, pUpdatePolygon) 
             
            On Error GoTo Handler
            If pGeometry Is Nothing Or pGeometry.IsEmpty Then 
                pFeature.Delete 
            Else 
                Set pFeature.Shape = pGeometry 
                pFeature.store        
              End If 
             
            SetSysProValue i 
            i = i + 1 
            DoEvents             rs.MoveNext 
     
NextFeature: 
            
        Loop 
         
Handler:
    Set pFeature = pFeaCursor.NextFeature 
    Goto NextFeature

Answer 2

不好意思，这是一个比较长的过程，我只贴了一点出来，我要得效果是这样的
Dim pFeaCursor As IFeatureCursor 
Dim pFeature As IFeature 
Dim pGeometry As IGeometry 
         
Set pFeaCursor = pFcls.Search(pSpatialFlt, False) 
Set pFeature = pFeaCursor.NextFeature 
Do While Not pFeature Is Nothing 
    Set pGeometry = TopoDifference(pFeature.ShapeCopy, pUpdatePolygon) 
             
On Error GoTo NextFeature 
    If pGeometry Is Nothing Or pGeometry.IsEmpty Then 
        pFeature.Delete 
    Else 
        Set pFeature.Shape = pGeometry 
        pFeature.store       
    End If 
             
    SetSysProValue i 
    i = i + 1 
    DoEvents 
             
NextFeature: 
     Set pFeature = pFeaCursor.NextFeature 
Loop 就是如果在循环内处理一条记录出错的话，就跳到NextFeature处理下一条记录

Answer 3

Dim pFeaCursor As IFeatureCursor  
Dim pFeature As IFeature  
Dim pGeometry As IGeometry  
          
Set pFeaCursor = pFcls.Search(pSpatialFlt, False)  
Set pFeature = pFeaCursor.NextFeature
On Error GoTo Resume Next  Do While Not pFeature Is Nothing  
    Set pGeometry = TopoDifference(pFeature.ShapeCopy, pUpdatePolygon)  
    If Err.Number = 0 Then
        If pGeometry Is Nothing Or pGeometry.IsEmpty Then  
            pFeature.Delete  
        Else  
            Set pFeature.Shape = pGeometry  
            pFeature.store        
        End If  
              
        SetSysProValue i  
        i = i + 1  
    End If
    DoEvents  
 
    Set pFeature = pFeaCursor.NextFeature  
Loop  

Answer 4

不能用ResumeNext，其中的有些语句我不想运行，有没有办法直接跳到NextFeature行

Answer 5

Do While Not pFeature Is Nothing  
    Set pGeometry = TopoDifference(pFeature.ShapeCopy, pUpdatePolygon)  
              
On Error GoTo ResumeNextFeature  
    If pGeometry Is Nothing Or pGeometry.IsEmpty Then  
        pFeature.Delete  
    Else  
        Set pFeature.Shape = pGeometry  
        pFeature.store        
    End If  
              
    SetSysProValue i  
    i = i + 1  
    DoEvents  
              
NextFeature:  
     Set pFeature = pFeaCursor.NextFeature  
Loop  ...
exit sub
ResumeNextFeature:
    Resume NextFeature
end sub

Answer 6

非常感谢Tiger_Zhao，我也遇到这个问题，你的方法不错！

Answer 7

public function ErrStore() as Boolean
   on error go to ErrPort
   ErrStore=True  'Initial
   Set pFeature.Shape = pGeometry 
   pFeature.store 
   ErrStore=True
   exit functionErrPort:
   ErrStore=false
end function
==========================================================================================        Dim pFeaCursor As IFeatureCursor 
        Dim pFeature As IFeature 
        Dim pGeometry As IGeometry 
         
        Set pFeaCursor = pFcls.Search(pSpatialFlt, False) 
        Set pFeature = pFeaCursor.NextFeature 
        Do While Not pFeature Is Nothing 
            Set pGeometry = TopoDifference(pFeature.ShapeCopy, pUpdatePolygon) 
            If pGeometry Is Nothing Or pGeometry.IsEmpty Then 
                pFeature.Delete 
            Else 
                if ErrStore=false then .........(goto NextFeature)'自己改进，不建议这样使用GOTO
            End If 
             
            SetSysProValue i 
            i = i + 1 
            DoEvents 
             
NextFeature: 
            Set pFeature = pFeaCursor.NextFeature 
        Loop 
         
NextLayer: 
        rs.MoveNext 
    Loop