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 SearchDomino.com 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
 DefineRichTextStyle
 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.
GetPrevDocument(docEmail)
  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       
      Else
       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
 Loop
 
 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))
 Next
 Call docEmail.Send
(False,gsesCurrent.EffectiveUserName)
 Exit Sub
ErrorHandler:
 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)
 pvarParentArray
(Ubound(pvarParentArray)) = pvarArrayItem
 Exit Function
ErrorHandler:
%REM 
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.
%END REM
 Redim Preserve pvarParentArray(0)
 Resume Next
End Function
Sub DefineRichTextStyle
 Set grtsRemovalDescription = 
gsesCurrent.CreateRichTextStyle() 
 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
 Else
  IsArrayMember = True
 End If 
 Exit Function
ErrorHandler:
 Redim Preserve pvarParentArray(0)
 Resume Next
End Function


MEMBER FEEDBACK TO THIS TIP

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 SearchDomino.com 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.

-ADS BY GOOGLE

SearchWindowsServer

Search400

  • iSeries tutorials

    Search400.com'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 ...

SearchDataCenter

SearchExchange

SearchContentManagement

Close