Re-association tool for parent/child documents.

The code below was placed in an agent to re-associate user responses (children) to a different data request (parent). The variables and conditions can be easily modified to suit your needs

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
		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")
			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, True)
			End If		
			Set doc = collect.getnextdocument(doc)
		Loop Until doc Is Nothing 
	End If
	'Save updates to recipients list
	Call, True)
End Sub

Posted by fbrefere001 on Thursday January 12, 2006