Manage Learn to apply best practices and optimize your operations.

Another way to remove duplicate attachments

This tip offers an alternative method for removing duplicate attachments from a user's e-mail database. The user submitted it after reading a similar tip.

View member feedback to this tip.

Editor's note: Vladimir submitted this tip to after reading a tip, Remove duplicate attachments from user's e-mail database,
which was posted in January and updated in July.

Here's improved code for the tip.
1. I fixed the bug that caused only one deletion of multiple copies per run.
2. I added sender, subject and filename to the summary e-mail.

In addition, I also recommend creating a view showing only documents with attachments and using that instead of "All Documents".

Dim gsesCurrent As NotesSession
Dim grtsRemovalDescription As NotesRichTextStyle 
Sub Initialize
 On Error Goto ErrorHandler
 Dim dbCurrent As NotesDatabase
 Dim vwAllDocuments As NotesView 
 Dim docEmail As NotesDocument, 
prevDocEmail As NotesDocument
 Dim rtiBody As NotesRichTextItem 
 Dim nrtiEmailBody As NotesRichTextItem
 Dim boolTestMode As Boolean 
 Dim intFileCount As Integer
 Dim lngTotalBytesFreed As Long
 Dim strFileNames As Variant
 Dim iTotalCount As Integer, iCount As Integer
 Dim strInfos As Variant, strInfo As String
 Dim itemFrom As NotesItem
 Select Case Messagebox("Do you wish 
to permanently remove all duplicate attachments 
(select No to run this utility in test mode)?", 
291, "Permanently Delete?")
 Case 6
  boolTestMode = False
 Case 7
  boolTestMode = True
 Case Else  
  Exit Sub
 End Select
 lngTotalBytesFreed = 0
 Redim strFileNames(0)
 Redim strInfos(0)
 Set gsesCurrent = New NotesSession
 Set dbCurrent = gsesCurrent.CurrentDatabase
 Set vwAllDocuments = dbCurrent.GetView ("($All)")
 Set docEmail = vwAllDocuments.GetLastDocument   
 iTotalCount = vwAllDocuments.AllEntries.Count
 iCount = 0
 Do While Not (docEmail Is Nothing) 
And iCount < iTotalCount
  intFileCount = 0   
  strInfo = ""
  Set prevDocEmail = vwAllDocuments.
  If docEmail.HasEmbedded 
And docEmail.HasItem("Body") Then  
   Print "Scanning: " & docEmail.Subject(0)   
   Set rtiBody = docEmail.GetFirstItem("Body")
   Set itemFrom = docEmail.GetFirstItem( "From" )
   strInfo = "From: " & itemFrom.Text & " 
Subject: " & docEmail.Subject(0)  & " "
   If ( rtiBody.Type = RICHTEXT ) Then
    Forall object In rtiBody.EmbeddedObjects
     If ( object.Type = EMBED_ATTACHMENT ) Then
      If IsArrayMember(strFileNames, 
object.Source & Cstr(object.FileSize)) Then
       intFileCount = intFileCount + 1
       If intFileCount = 1 Then
        Call rtiBody.AddNewLine (2) 
        Call rtiBody.AppendStyle(grtsRemovalDescription) 
        Call rtiBody.AppendText
("Attachment(s) removed from this document:")
        Call rtiBody.addnewline (1)
       End If
       Call rtiBody.AddNewLine (1)
       Call rtiBody.AppendText(object.Source)
       lngTotalBytesFreed = 
lngTotalBytesFreed + object.FileSize
       Print "Removed: " & Cstr(lngTotalBytesFreed) & " bytes"
       strInfo = strInfo & "  File name: " & object.Source & " " 
       If Not (boolTestMode) Then Call object.Remove       
       AddToArray strFileNames, 
object.Source & Cstr(object.FileSize)
      End If
     End If
    End Forall
   End If
   If  intFileCount > 0  Then
    AddToArray strInfos, strInfo
    If Not (boolTestMode) Then
     Call docEmail.Save(True, True)
    End If
   End If
  End If
  Set docEmail = prevDocEmail
  iCount = iCount + 1
 Set docEmail = dbCurrent.CreateDocument
 docEmail.Form = "Memo"
 docEmail.Subject = "Results of removal 
of duplicate attachments from database " 
& dbCurrent.Title
 Set nrtiEmailBody = docEmail.CreateRichTextItem("Body")
 Call nrtiEmailBody.AppendText
("Bytes freed: " & Cstr(lngTotalBytesFreed)  & Chr$(10) & Chr$(13))
 For iCount = Lbound(strInfos) 
To Ubound(strInfos)
  Call nrtiEmailBody.AppendText
(strInfos(iCount)  & Chr$(10) & Chr$(13))
 Call docEmail.Send
 Exit Sub
 Print {Error #} & Str(Err()) & { in line } & 
Str(Erl()) & { of } & {Remove Duplicate
 Attachments} & {: "} & Error$ & {"}
 Resume Next
End Sub
Function AddToArray(pvarParentArray As
 Variant, pvarArrayItem As Variant) 
'This function appends a value of any 
datatype to an array of the same datatype
 On Error Goto ErrorHandler
 If Isnull(pvarParentArray) Then
  Redim pvarParentArray(0)
 End If
 Redim Preserve 
pvarParentArray(Ubound(pvarParentArray) + 1)
(Ubound(pvarParentArray)) = pvarArrayItem
 Exit Function
All errors in this context assume the
 array has not yet been initialized; 
hence, the array is redimmed to 
a bound of 0 to store the 
parameter's value / object.
 Redim Preserve pvarParentArray(0)
 Resume Next
End Function
Sub DefineRichTextStyle
 Set grtsRemovalDescription = 
 grtsRemovalDescription.NotesColor = 8 'Maroon
 grtsRemovalDescription.FontSize = 8 
 grtsRemovalDescription.Bold = True
End Sub
Function IsArrayMember (pvarParentArray 
As Variant, pvarArrayItemValue 
As Variant) As Variant
 On Error Goto ErrorHandler
 If Isnull (Arraygetindex(pvarParentArray, 
pvarArrayItemValue, 5)) Then
  IsArrayMember = False
  IsArrayMember = True
 End If 
 Exit Function
 Redim Preserve pvarParentArray(0)
 Resume Next
End Function


Is there a way to put in a doclink to the original attachment? That would make it so much easier to find the attachment they are looking for.

—Tony R.


I believe a mail database is not the right place to store attachments or look for them. Besides, since we remove duplicate attachments from e-mails going back and forth, all those e-mails are grouped together in the "Mail Threads" view.

—Vladimir Tankhimovich, tip author

Do you have comments on this tip? Let us know.

This tip was submitted to the tip exchange by member Vladimir Tankhimovich. Please let others know how useful it is via the rating scale below. Do you have a useful Notes/Domino tip or code to share? Submit it to our bimonthly tip contest and you could win a prize and a spot in our Hall of Fame.

This was last published in July 2005

Dig Deeper on LotusScript

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.




  • iSeries tutorials's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...