How do you fix the Mail Archiving Agent so it keeps documents in the right folders?

There is a sample modified database on The View's web site. What it does is create a categories field with a list of the folders the document belongs in so it can carry the folder location information with the document when it is moved into the archive.

Pawel Bartuzi (pawel.bartuzi@kir.com.pl) suggested fixing Lotus' archiving agents instead.
Modifications made to mail archiving agent ("Periodic Archive", Notes 4.6.5):

In the Declarations section added:

  'PB start
  Dim strlstFolders_g List As String
  'PB end

In the ProcessDocuments procedure added an the very beginning::

  'PB start
  Dim doc_l As NotesDocument
  Dim strUNID_l As String
  Dim lngCount_l As Long

  Forall a In dbSource.Views
    If a.IsFolder Then
      If (Not a.Name Like "(*)") Or (a.Name = "($Inbox)") Then
        Set doc_l = a.GetFirstDocument
        Do While Not doc_l Is Nothing
          strUNID_l = doc_l.UniversalID
          If Iselement(strlstFolders_g(strUNID_l)) Then
            strlstFolders_g(strUNID_l) = strlstFolders_g(strUNID_l) & ";" & a.Name
          Else
            strlstFolders_g(strUNID_l) = a.Name
            lngCount_l = lngCount_l + 1
            If Not session.IsOnServer Then  Print "Reading documents... " & a.Name & " - " & lngCount_l
          End If
          Set doc_l = a.GetNextDocument(doc_l)
        Loop
      End If
    End If
  End Forall
 'PB end

and, an the beginning of the for...loop:

 'PB start
 If Not session.IsOnServer Then Print "Checking documents... " & i & " of " & numDocs
 'PB end

In the ArchiveDocument procedure, add at the very end:

 'PB start
 Dim strFolders_l As String
 Dim strFolder_l As String
 Dim intPos_l As Integer

 If Iselement(strlstFolders_g(docSource.UniversalID)) Then
   strFolders_l = strlstFolders_g(docSource.UniversalID)
   intPos_l = 0
   Do While Not Len(strFolders_l) = 0
     intPos_l = Instr(1, strFolders_l, ";")
     If intPos_l = 0 Then
       strFolder_l = strFolders_l
       strFolders_l = ""
     Else
       strFolder_l = Left$(strFolders_l, intPos_l - 1)
       strFolders_l = Right(strFolders_l, Len(strFolders_l) - (intPos_l))
     End If
     Call docArchive.PutInFolder(strFolder_l)
   Loop
 End If
 'PB end

Remarks:

- Further optimizations can be done to minimize the size of the strlstFolders_g list by creating something like a "folder dictionary": then only folder IDs would be put in the list, it could be beneficial on very large mailboxes with very long folder names.
- Modifications to the "Archive selected documents" agent are basically the same, with the exception that some global variable names differ (docSource->note, docArchive->newnote, session->s, dbSource->sourcedb), also you have to be more careful where you place modifications as there are fewer procedures in "Archive selected..." than in "Periodic Archive" and they are longer.

Applies to Notes Versions: 4
4.5
4.6
5