How to count and delete deletion stubs

Christophe Windelen wrote a blog entry a couple of years ago with a solution on how to delete deletion stubs for a Lotus Notes database. Take a look at his code to accomplish that, very nice!

I have modified it just a little bit to be able to first choose which database to work on and then to choose if you only want to count or if you want to count and delete them

(Options):

Option Public
Const wAPIModule = "NNOTES" ' Windows/32

(Declarations):

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

Initialize:

Sub Initialize
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

dbInfo = ws.Prompt(13, "Choose database", "Choose a database")
sDbServer = dbInfo(0)
sDbPath = dbInfo(1)

Set db = session.GetDatabase(sDbServer, sDbPath)

retVal = ws.Prompt (PROMPT_YESNOCANCEL, _
"Delete or just count?", _
"Do you want to delete all of the deletion stubs in this database [Yes] or just count them [No]")

Select Case retVal
Case 1 : Call countAndDeleteStubs(db, 1)
Case 0 : Call countAndDeleteStubs(db, 0)
Case -1 : Msgbox "Operation cancelled"
End Select

End Sub

countAndDeleteStubs:

Sub countAndDeleteStubs(db As NotesDatabase, choice As Integer)
Dim ever As Currency, last As Currency
Dim hT As Long, RRV As Long, hDB As Long
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
Msgbox "Deleted " & Cstr(n&) & " stubs in database " & db.FilePath & " on server " & db.Server
Else
Msgbox "Database " & db.FilePath & " on server " & db.Server & " contains " & Cstr(n&) & " stubs"
End If

End Sub

And here are the results when running the count...