für die "Selbermacher" unter euch hier der Code für die MoveToOtherDocument func.
Function MovetootherDocument(me_db As notesdatabase, me_doc As NotesDocument, me_Parentdocunid As String) As Boolean
%REM
###################################################################################
Goal: This function builds an answer Mail document to an existing task or other document
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Arguments: Description:
me_db Notesdatabase The Calling Notes DB
me_doc Notesdocument the document that is worked on
me_Parentdocunid string UNid of the in a previous step found document
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Return:
boolean true or false if there was an error
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Example:
ok = MovetootherDocument(db,doc,unid)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
VERSION / WHEN / WHO / CHANGES
1.0/24.03.2005/Thomas Schulte/none
'###################################################################################
%END REM
Dim parentdocument As NotesDocument
Dim newticket As NotesDocument
Dim rtitem As NotesRichTextItem
Dim rtBodyNewTicket As NotesRichTextItem
Dim item As NotesItem
Dim problem As String
Dim datetime As New NotesDateTime("")
Dim mailfornumber As String
Dim subject As String
Dim asubject As Variant
Const NEW_LINE = Uchr$(13)
On Error Goto ErrorHandler
MovetootherDocument = True
Set parentdocument = me_db.GetDocumentByUNID(me_parentdocunid)
Set NewTicket = New NotesDocument( me_db )
Set item = NewTicket.ReplaceItemValue ("Form", "BugMail")
Set item = NewTicket.ReplaceItemValue ("Status", "0")
Set item = me_doc.GetFirstItem( "DeliveredDate" )
Set datetime = item.DateTimeValue
Set item = NewTicket.ReplaceItemValue("DateCreated", datetime.DateOnly)
Set item = NewTicket.ReplaceItemValue("TimeCreated", datetime.TimeOnly)
Set item = NewTicket.ReplaceItemValue ("Pauseuntil", "")
Set item = NewTicket.ReplaceItemValue ("Rerouted", "0")
Set item = NewTicket.ReplaceItemValue ("Reroutedto", "")
Set item = NewTicket.ReplaceItemValue ("Reroutedby", "")
Set item = NewTicket.ReplaceItemValue ("PrevEditor", "")
' authors
' accessserver
Set item = NewTicket.ReplaceItemValue ("DateRerouted", "")
Set item = NewTicket.ReplaceItemValue ("Reopened", "0")
' history
Set item = NewTicket.ReplaceItemValue ("Count", "1")
Set item = NewTicket.ReplaceItemValue ("FormType", "Mail")
If parentdocument.HasItem("user") Then
Set item = parentdocument.GetFirstItem( "user" )
Call item.CopyItemToDocument ( NewTicket, "user")
mailfornumber = item.Text
End If
If parentdocument.HasItem("otherusers") Then
Set item = parentdocument.GetFirstItem( "otherusers" )
Call item.CopyItemToDocument ( NewTicket, "otherusers")
mailfornumber = item.Text
End If
Set item = NewTicket.ReplaceItemValue ("MailWay", "1")
If parentdocument.HasItem("reqnumber") Then
Set item = parentdocument.GetFirstItem( "reqnumber" )
Call item.CopyItemToDocument ( NewTicket, "reqnumber")
mailfornumber = item.Text
End If
If parentdocument.HasItem("tasknumber") Then
Set item = parentdocument.GetFirstItem( "tasknumber" )
Call item.CopyItemToDocument ( NewTicket, "tasknumber")
mailfornumber = item.Text
End If
Set item = NewTicket.ReplaceItemValue ("mailfornumber", mailfornumber)
Set item = NewTicket.ReplaceItemValue ("MailSendCounter", 1)
If me_doc.HasItem("From") Then
Set item = me_doc.GetFirstItem( "From" )
Call item.CopyItemToDocument ( NewTicket, "MailCreator")
End If
If me_doc.HasItem("SendTo") Then
Set item = me_doc.GetFirstItem( "SendTo" )
Call item.CopyItemToDocument ( NewTicket, "SendTo")
End If
If me_doc.HasItem("CopyTo") Then
Set item = me_doc.GetFirstItem( "CopyTo" )
Call item.CopyItemToDocument ( NewTicket, "CopyTo")
End If
subject = replaceanswercode(me_doc.subject(0))
Set item = NewTicket.ReplaceItemValue("MailSubject",Subject)
If me_doc.HasItem("Body") Then
Set rtitem = me_doc.GetFirstItem( "Body" )
Set rtBodyNewTicket = New NotesRichTextItem ( NewTicket, "MailBody" )
Call rtBodyNewTicket.AppendRTItem( rtitem)
End If
' create the asubject field
asubject = CreateASubject(newticket,"ASubjectMail")
If Isarray( asubject) = True Then
Set item = NewTicket.ReplaceItemValue("ASubject",asubject)
End If
Call NewTicket.MakeResponse(parentdocument)
Call NewTicket.Save (True,True)
TheEnd:
Exit Function
ErrorHandler:
MovetootherDocument = False
Print "MovetootherDocument: " & Trim$(Str$(Err)) & " on line " & Cstr(Erl) &": " & Error$
Resume TheEnd
End Function
