Archiving your mail database is such, a mundane task that this simple task turned into a complete nightmare for our company. The archive setting on the advance tab "do not delete documents that have responses" confused us. Most of our users checked the setting resulting in them archiving, but the mail database not getting any smaller. This frustrated our users and sent the administrators on a hunt to find out what went wrong. We isolated the problem to the setting, but the solution was not so straightforward. When faced with a mail database over a gig, you just can't tell that user to manually figure out which documents are duplicates and delete them!
Sub Initialize Dim Session As New Notessession Dim Active As NotesDatabase Dim Archive As NotesDatabase Dim aDoc As NotesDocument Dim Profile As NotesDocument Dim AllView As NotesView Dim Ar_MessageID() As String Dim Archivedb As String Dim Path As String Dim X As Integer Dim Y As Integer Set Active = Session.CurrentDatabase Set Profile = Active.GetProfileDocument("Archive Profile") Forall items In profile.Items If items.name = "ArchivePath" Then Archivedb = items.text End If End Forall Set Archive = New NotesDatabase("",Archivedb) 'First build A_MessageID from the Archive database Set AllView = Archive.GetView("($All)") Set aDoc = AllView.GetFirstDocument X=0 While Not aDoc Is Nothing Redim Preserve Ar_MessageID(X) Ar_MessageID(X) = aDoc.universalid X = X + 1 Set aDoc = AllView.GetNextDocument(aDoc) Wend X = X - 1 Print X, 'Loop through Active database and compare with Archive Set AllView = Active.GetView("($All)") Set aDoc = AllView.GetFirstDocument While Not aDoc Is Nothing X=0 Do While X <= Ubound(Ar_MessageID) If Ar_MessageID(X) = aDoc.universalid Then 'There is a match now put in a folder for identification by the user Y = Y + 1 Call aDoc.PutInFolder("ARCHIVE-DUPLICATES") Exit Do End If X = X + 1 Loop Set aDoc = AllView.GetNextDocument(aDoc) Wend Print Y End Sub