Michael Brown - Blogging for Dominos

If you've ever wondered how many people still have Soft Deletions enabled or disabled, here's a script that you can run.  It also reports on the number of hours users have specified that emails will remain in the trash before being purged based on the "Soft Delete Expire Time in Hours" field located on the Advance Tab of the DB Properties.
Don't be amazed when you find someone that has increased the number hours to purge soft deletions to 8760 hours or one year.

Sub Initialize
     Dim db As NotesDatabase
     Dim nc As NotesNoteCollection
     Dim icon As NotesDocument
     Dim filenum As Integer
     Dim pos As Integer
     Dim found As Integer
     Dim filename As String
     Dim strOutput As String
     Dim nid As String
     Dim servername As String
     Dim mailpath As String
     Dim strFlags As Variant
     Dim SDExpire As String
     
'PARAMETERS TO CODE
'Indicate mail subdirectory name
     mailpath = Lcase("mail")
'Text filename to write the output to. Writes to Notes program directory.
     filename = "SoftDeletions.txt"
'Server name (in canonical format):
     servername = "ServerName/HERE"
     
     Dim dbdir As New NotesDbDirectory(servername)
     filenum = Freefile()
     Open filename For Output As fileNum
     
     Set db = dbdir.GetFirstDatabase(DATABASE)
     While Not db Is Nothing
'Skip databases which you don't have access to
             On Error 4060 Goto Error4060
'Check to see if this database is in the mail directory
             pos = Instr(Lcase(db.FilePath), mailpath)
             If pos = 1 Then
                     Call db.Open(servername, db.FilePath)
                     Set nc = db.CreateNoteCollection(False)
                     nc.SelectIcon = True
                     Call nc.BuildCollection
                     nid = nc.GetFirstNoteId
                     Set icon = db.GetDocumentByID(nid)
                     strFlags = icon.GetItemValue("$Flags")
                     found = Instr(strFlags(0), "4")
                     Set doc1 = db.GetProfileDocument("CalendarProfile")
                     SDExpire = Cstr(doc1.SoftDeleteExpireTime(0))
                     
                     If found <> 0 Then
                             Print #filenum, db.Title                                
                             Print #filenum, db.FilePath & " has soft deletions enabled. 1"
                             Print #filenum, SDExpire & " hours for purge."                
                             Print #filenum, ""
                             Print db.filepath
                     End If
                     If found = 0 Then
                             Print #filenum, db.Title        
                             Print #filenum, db.FilePath & " has soft deletions disabled. 0"
                             Print #filenum, SDExpire & " hours for purge."
                             Print #filenum, ""
                             Print db.filepath
                     End If
             End If
             maildb=False
GetNextDb:
             Set db = dbdir.GetNextDatabase()
     Wend
     Close filenum
     Exit Sub
     
Error4060:
'If the code reaches here then the user does not have access rights.
     Print #filenum, db.FilePath & " incorrect rights to access!"
     Resume GetNextDb
End Sub



Based on the script found here with minor modifications