I saw the other gentleman's code to archive docs and their response docs. I was immediately prompted to post this. This code will archive a parent doc with all of it's response documents to another database. The response heirarchy (which may be multi-level) is maintained.
Dim NewParentUNID As String
NewParentUNID = ArchiveDocument (Doc, Nothing, TargetDatabase, "")
The first parameter is the parent NotesDocument for everything. Pass in the doc you want to archive.
The second parameter is only used internally by the function. Call it with the Nothing object. This is a NotesDocument for the parent of the document in the first parameter.
pThe third parameter is the target NotesDatabase.
The forth parameter is a running list of Universal IDs. I've seen databases that have broken response structures where a parent can be a child of one of it's children. This looks like Doc.Responses(0).Responses(0) = Doc. This just prevents the code from entering an infinite loop.
Function ArchiveDocument(SourceDoc As NotesDocument, ParentDoc As NotesDocument, ArchiveDb As NotesDatabase, PrevUNIDs As String) As String Dim TargetDoc As NotesDocument Dim ResponseDoc As NotesDocument Dim i As Integer Dim NUL As Variant If Instr(PrevUNIDs, SourceDoc.UniversalID) = 0 Then PrevUNIDs = PrevUNIDS & "," & SourceDoc.UniversalID Set TargetDoc = SourceDoc.CopyToDatabase(ArchiveDb) TargetDoc.ArchiveDate = Now() If Not (ParentDoc Is Nothing) Then Call TargetDoc.MakeResponse(ParentDoc) End If Call TargetDoc.Save(True, True) ArchiveDocument = Trim(Cstr(TargetDoc.UniversalID)) If SourceDoc.Responses.Count > 0 Then For i = 1 To SourceDoc.Responses.Count Set ResponseDoc = SourceDoc.Responses.GetNthDocument(i) If Not ResponseDoc Is Nothing Then NUL = ArchiveDocument(ResponseDoc, TargetDoc, ArchiveDb, PrevUNIDs) End If Next End If Call SourceDoc.Remove(True) End If End Function