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.
Example usage:
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.
Code
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