Private Sub Löschen()
 
On Error GoTo ErrFilter
 
sevWaitBar.Visible = True
sevWaitBar.ShowBar
 
Do
DoEvents
    Set adors = New ADODB.Recordset
 
    With adors
              .ActiveConnection = FomWerkstatt.cnLager
              .Source = "SELECT Likurz " & _
                        "From LagerTis " & _
                        "where LiKurz=" & Index
              .CursorLocation = adUseClient
              .CursorType = adOpenKeyset
              .LockType = adLockOptimistic
              .Open
     End With
 
     If Not adors.EOF = True Then
          strSQL = "Delete LagerTis FROM (Select Top 5000 LagerTis.* From" & _
            "LagerTis where  
                    LagerTis.LiKurz=" & Index & ") as xTis where _
                    LagerTis.IDLagerTis=xTis.IDLagerTis 
                    and LagerTis.LiKurz=" & Index
 
           FomWerkstatt.cnLager.Execute (strSQL)
 
               If Not adors Is Nothing Then
                     adors.Close
                     Set adors = Nothing
              End If
 
     Else
 
              If Not adors Is Nothing Then
                     adors.Close
                     Set adors = Nothing
              End If
 
        Exit Do
 
     End If
 
 Loop
 
sevWaitBar.Visible = False
 
Exit Sub
 
ErrFilter:
  Msg.MsgBox Error$
 
End Sub