Domino Code Fragment

Code Name*
Prevent deletion of document if response exist		Date*
04/29/2024		Source (or email address if you prefer)*
Rlatulippe@romac.com
IP address:.3.143.168.172
Description*
Checks document to be deleted and prevents the deletion if a response exist		Type*
LotusScript		Categories*
(Misc)
Implementation:
Required Client:
Server:
Limitations:
Comments:
Files/Graphics attachments (if applicable): Code:
Sub Querydocumentdelete(Source As Notesuidatabase, Continue As Variant)
'Delcare the database and document(s) this agent is working on
    Dim uidb As notesUIdatabase
    Dim collection As notesdocumentcollection
    Dim doc As Notesdocument
    Dim ChildCollection As notesdocumentcollection
'NotesUIDatabase class is only accessible as a source parameter
    Set uidb = source
   
'Get to the document(s) selected for deletion
    Set collection = uidb.documents
    Set doc = collection.GetFirstDocument
   
'Walk through the document collection.
    Do
         Set ChildCollection = doc.responses
'If any documents is not a response warn the user and stop the deletion
         If ChildCollection.count > 0 Then
'Tell the user they cannot delete the document
              Messagebox doc.DispRestrictionTitle(0) & Chr(13) & Chr(13) & "This documents contains responses and cannot be deleted!" & Chr$(10) & "Please delete responses first", 16, "Invalid Deletion Attempt!"
'Stop execution of the delete process
               Continue = False
'Bail out of the program if a document is marked as "Permanent"
              Exit Sub
         End If
'Otherwise, get the next document in the collection
         Set doc=collection.GetNextdocument(doc)
'Go through the process of checking for response documents until there are no document(s) left
    Loop Until doc Is Nothing
   
End Sub