Domino Code Fragment

Code Name*
Remove Attachments from Selected Docs
Date*
09/20/1999
Source (or email address if you prefer)*
Anonymous
IP address:.18.116.62.45
Description*
Type*
LotusScript
Categories*
Email/PIM
Implementation:
None (plug and play)
Required Client:
4.6
Server:
(none)
Limitations:
None that I know of
Comments:
I use an agent with a
Files/Graphics attachments (if applicable): Code:
Sub Initialize
Dim S As New NotesSession
Dim collection As NotesDocumentCollection
Dim doc As NotesDocument
Dim db As NotesDatabase

Set db = S.currentDatabase
Set collection = db.UnprocessedDocuments

If (collection.Count = 0) Then
Messagebox("No documents selected.")
Exit Sub
End If
Set doc = collection.GetFirstDocument()

Dim totalsize As Long
Dim count As Long
Dim rtitem As NotesRichTextItem
Do While Not(doc Is Nothing)
If (doc.HasEmbedded) Then
Set rtitem = doc.GetFirstItem("Body") '...grab a handle to the Body field so we can log our removal of file attachments
Forall o In rtitem.EmbeddedObjects
count = count + 1 '...increase the file attachment counter
totalsize = totalsize + o.filesize '...increase the total size counter
Call rtitem.AppendText("File " & o.Source & " was removed on " & Str$(Today) ) '...log removal of the file
Call rtitem.AddNewLine(1) '... add a new line
Call o.Remove() '...finally remove the file attachment
End Forall
End If
Call doc.save(True, True) '...commit our changes to the current doc
Set doc = collection.GetNextDocument(doc) ' get the next document
Loop
used = db.PercentUsed
If (used < 85) Then
warning = " You should probably compact this database."
End If
Messagebox(Str$(count) & " document(s) were removed, totaling " & Str$(totalsize) & " bytes. " & Str$(used) & "% of this database is now used." & warning)
End Sub