Работа со "stubs" (окурками, удаленных документов)

На днях... решая очередную задачу по db.search, столкнулся ,по началу,с непонятной вещью, а именно, в отчет лезут удаленные документы. Непорядок... нужно избавляться, и занялся я борьбой с последствиями курения - окурками.


Option Public
Option Declare

Dim strErrMessage
Const wAPIModule = "NNOTES"
Declare Private Sub IDDestroyTable Lib wAPIModule Alias "IDDestroyTable" _
( ByVal hT As Long)
Declare Private Function IDScan Lib wAPIModule Alias "IDScan" _
( ByVal hT As Long, ByVal F As Integer, ID As Long) As Integer
Declare Private Function NSFDbOpen Lib wAPIModule Alias "NSFDbOpen" _
( ByVal P As String, hDB As Long) As Integer
Declare Private Function NSFDbClose Lib wAPIModule Alias "NSFDbClose" _
( ByVal hDB As Long) As Integer
Declare Private Function NSFDbGetModifiedNoteTable Lib wAPIModule Alias "NSFDbGetModifiedNoteTable" _
( ByVal hDB As Long, ByVal C As Integer, ByVal S As Currency, U As Currency, hT As Long) As Integer
Declare Private Function NSFNoteDelete Lib wAPIModule Alias "NSFNoteDelete" _
( ByVal hDB As Long, ByVal N As Long, ByVal F As Integer) As Integer
Declare Private Function OSPathNetConstruct Lib wAPIModule Alias "OSPathNetConstruct" _
( ByVal NullPort As Long, ByVal Server As String, ByVal FIle As String, ByVal PathNet As String) As Integer
Declare Private Sub TimeConstant Lib wAPIModule Alias "TimeConstant" _
( ByVal C As Integer, T As Currency)
Dim Db As NotesDatabase

Sub countAndDeleteStubs(db As NotesDatabase, choice As Integer)
On Error GoTo errmes
Dim ever As Currency, last As Currency
Dim hT As Long, RRV As Long, hDB As Long
Dim n&,done,np$
With db
np$ = Space(1024)
OSPathNetConstruct 0, db.Server, db.FilePath, np$
End With
NSFDbOpen np$, hDB
TimeConstant 2, ever
NSFDbGetModifiedNoteTable hDB, &H7FFF, ever, last, hT
n& = 0
done = (IDScan(hT, True, RRV) = 0)
While Not done
If RRV < 0 Then
If (choice = 1) Then
NSFNoteDelete hDB, RRV And &H7FFFFFFF, &H0201
End If
n& = n& + 1
End If
done = (IDScan(hT, False, RRV) = 0)
Wend
IDDestroyTable hT
NSFDbClose hDB

If (choice = 1) Then
print "Удалено " & CStr(n&) & " окурков в базе данных " & db.FilePath & " на сервере " & db.Server
Else
print "В базе данных " & db.FilePath & " на сервере " & db.Server & " найдено " & CStr(n&) & " окурков"
End If
Exit sub
errmes:
strErrMessage = "Ошибка " & Error$ & " выполняемая процедура " & GetThreadInfo(10) &" текущая процедура " & GetThreadInfo(1) & ", в строке " & CStr(Erl)
Print strErrMessage
End Sub

Sub findstubs
'поиск окурков
On Error GoTo errmes
Dim Session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim dbInfo As Variant
Dim sDbServer As String
Dim sDbPath As String
Dim retVal As Integer

Set db = session.Currentdatabase
retVal = ws.Prompt (PROMPT_YESNOCANCEL,"Удалить ""Окурки""?","Удалить все [да] или показать их число [Нет]")
Select Case retVal
Case 1 : Call countAndDeleteStubs(db, 1)
Case 0 : Call countAndDeleteStubs(db, 0)
Case -1 : print "Отменено"
End Select
Print "Процедура сжатия базы данных..."
Call db.Compact
Exit Sub
errmes:
strErrMessage = "Ошибка " & Error$ & " выполняемая процедура " & Getthreadinfo(10) &" текущая процедура " & Getthreadinfo(1) & ", в строке " & Cstr(Erl)
Print strErrMessage
End Sub