Sub Initialize
Dim session As New notessession
Dim db As notesdatabase
Set db = session.currentdatabase
Dim collect As notesdocumentcollection
Set collect = db.unprocesseddocuments
If collect.count = 0 Then
Msgbox "No records were selected"
Exit Sub
Elseif collect.count = 1 Then
Msgbox "You must select more than one record"
Exit Sub
End If
Dim doc As notesdocument
Set doc = collect.getfirstdocument
Dim pdoc As notesdocument
Dim parentcount As Integer
Dim childcount As Integer
'Get a handle on the parents
Do
If doc.form(0) = "DR" Then
parentcount = parentcount + 1
Set pdoc = doc
Elseif doc.form(0) = "UR" Then
childcount = childcount + 1
End If
Set doc = collect.getnextdocument(doc)
Loop Until doc Is Nothing
'Verify only one parent was selected
If parentcount = 0 Then
Msgbox "No parent data request were selected to associate with."
Exit Sub
Elseif parentcount > 1 Then
Msgbox "You can only select one parent data request to associate with."
Exit Sub
Elseif childcount = 0 Then
Msgbox "No child user responses were selected to re-associate."
Exit Sub
End If
'prompt user to verify before executing
If Msgbox( "You are about to re-associate " & childcount & " records to the selected parent, do you wish to proceed?" , 4 + 32 + 256 , "Re-Associate" ) = 6 Then
'Loop and update appropriate recorcds
Set doc = collect.getfirstdocument
Dim Recpitem As NotesItem
Set Recpitem = pdoc.GetFirstItem("dr_recipients")
Do
If doc.form(0) = "UR" Then
'Move this user to the Recipients field
Call Recpitem.AppendToTextList(doc.ur_recipient(0))
'Update appropriate fields
doc.ur_compname = pdoc.dr_compname(0)
doc.ur_Title = pdoc.dr_title(0)
doc.ur_message = pdoc.dr_message(0)
doc.ur_ParentDocumentID = pdoc.UniversalID
'===============================
Dim item4 As NotesItem
Set item4 = pdoc.GetFirstItem( "dr_duedate" )
If Not item4 Is Nothing Then Call doc.CopyItem( item4, "ur_duedate" )
'===============================
doc.ur_collectiontype = pdoc.dr_collectiontype(0)
doc.ur_autoreminder = pdoc.dr_autoreminder(0)
Call doc.MakeResponse( pdoc )
Call doc.save(True, True)
End If
Set doc = collect.getnextdocument(doc)
Loop Until doc Is Nothing
End If
'Save updates to recipients list
Call pdoc.save(True, True)
End Sub