Ok unter Umständen gibt es da doch einen Fehler. Prüf doch mal nach ob in der Lib.Appl.Functions in der Function CreateNewTicket folgender Code enthalten ist
If sendtoflag = True And copytoflag = True Then
otherusers = Arrayappend(sendtoarray,copytoarray)
Elseif sendtoflag = True And Copytoflag = False Then
otherusers = sendtoarray
Elseif sendtoflag = False And Copytoflag = True Then
otherusers = copytoarray
Else
' raise an error because there should be at last one of this fields
Error 9999, "Neither sendto nor copyto field was found in the document. ID" + me_doc.UniversalID
End If
' remove all duplicate entrys and the Databases MailIn Name from the OtherUsers Field
'first the duplicate entrys
otherusers = Arrayunique(otherusers)
' then empty everything that is in a configuration document
thisvalues = Split(Lcase(getConfigdocbyKeyMultivalue("DispatcherRemoveNamesFromOtherUsers","~")),"~")
otherusers = Arrayreplace(otherusers,thisvalues,"")
' at last do a fulltrim to extinct all empty entrys
otherusers = Fulltrim(otherusers)
If otherusers(0)<> "" Then
Set item = New NotesItem( NewTicket, "OtherUsers", Otherusers , NAMES )
End If
in den Dims.
Function CreatenewTicket(me_db As NotesDatabase, me_doc As notesdocument) As String
%REM
###################################################################################
Goal: This function creates a new Ticket out of a mailed document
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Arguments: Description:
me_db Notesdatabase The Calling Notes DB
me_doc Notesdocument the document that is worked on
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Return:
string UNID of the created document
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Example:
UNID = CreatenewTicket(db,doc)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
VERSION / WHEN / WHO / CHANGES
1.0/24.03.2005/Thomas Schulte/none
1.1/4.04.2005/eknori/ErrorHandling for fields
1.2/06.06.2005/Thomas Schulte/Handling of two different document types (memo/Reply and newbugreport)
1.3/02.08.2005/Thomas Schulte/Creating info mail the same way the save event within the bugReoprt form does
1.4/28.09.2005/Thomas Schulte/added parsing for MessageClick
'###################################################################################
%END REM
Dim newticket As NotesDocument
Dim item As NotesItem
Dim sendtoitem As notesitem
Dim copytoitem As NotesItem
Dim rtitem As NotesRichTextItem
Dim rtBodyNewTicket As NotesRichTextItem
Dim problem As String
Dim plainText As String
Dim asubject As Variant
Dim namesfield As Variant
Dim uniquenumber As Variant
Dim maxProblemLength As Integer
Dim me_notesitem As NotesItem
Dim docmailsend As String
Dim evalstring As String
Dim evalvar As Variant
Dim isnotesuser As Boolean
Dim message As String
Dim messageClick As String
Dim messageintern As String
Dim messagestringsplit As Variant
Dim ok As Boolean
Dim me_String As String
Dim otherusers As Variant
Dim sendtoArray() As String
Dim copytoarray() As String
Dim thisvalues As Variant
Dim sendtoflag As Boolean
Dim copytoflag As Boolean
Dim i As Integer
Const NEW_LINE = Uchr$(13)
On Error Goto ERRHANDLE
createnewticket = ""
Set NewTicket = New NotesDocument( me_db )
If me_doc.form(0) = "newBugReport" Then
' Copy the all the documents items into the new document
Call me_doc.CopyAllItems(newTicket,True)
Else
If me_doc.HasItem("From") Then
Set item = me_doc.GetFirstItem( "From" )
Call item.CopyItemToDocument ( NewTicket, "User")
End If
sendtoflag = False
copytoflag = False
If me_doc.HasItem("SendTo") Then
Set sendtoitem = me_doc.GetFirstItem( "SendTo" )
Redim sendtoarray(Ubound(sendtoitem.Values))
i= 0
Forall me_val In sendtoitem.Values
sendtoarray(i) = Lcase(me_val)
I=i+1
End Forall
Sendtoflag = True
End If
If me_doc.HasItem("CopyTo") Then
Set copytoitem = me_doc.GetFirstItem( "CopyTo" )
Redim CopyToarray(Ubound(copytoitem.Values))
i= 0
Forall me_val In copytoitem.Values
copytoarray(i) = Lcase(me_val)
I=i+1
End Forall
copytoflag =True
End If
If sendtoflag = True And copytoflag = True Then
otherusers = Arrayappend(sendtoarray,copytoarray)
Elseif sendtoflag = True And Copytoflag = False Then
otherusers = sendtoarray
Elseif sendtoflag = False And Copytoflag = True Then
otherusers = copytoarray
Else
' raise an error because there should be at last one of this fields
Error 9999, "Neither sendto nor copyto field was found in the document. ID" + me_doc.UniversalID
End If
' remove all duplicate entrys and the Databases MailIn Name from the OtherUsers Field
'first the duplicate entrys
otherusers = Arrayunique(otherusers)
' then empty everything that is in a configuration document
thisvalues = Split(Lcase(getConfigdocbyKeyMultivalue("DispatcherRemoveNamesFromOtherUsers","~")),"~")
otherusers = Arrayreplace(otherusers,thisvalues,"")
' at last do a fulltrim to extinct all empty entrys
otherusers = Fulltrim(otherusers)
If otherusers(0)<> "" Then
Set item = New NotesItem( NewTicket, "OtherUsers", Otherusers , NAMES )
End If
If me_doc.HasItem("Body") Then
Set rtitem = me_doc.GetFirstItem( "Body" )
If ( rtitem.Type = RICHTEXT ) Then
plainText = rtitem.GetFormattedText( False, 0 )
End If
' find the max melnth of the problem text
maxProblemLength = Cint(GetConfigDocByKey("MaxLengthProblemDescription"))
Problem = Left$(plainText,maxProblemLength)
Set rtBodyNewTicket = New NotesRichTextItem ( NewTicket, "Body" )
Call rtBodyNewTicket.AppendRTItem( rtitem)
End If
If me_doc.HasItem("Subject") Then
Set item = me_doc.GetFirstItem ("Subject")
Set item = NewTicket.ReplaceItemValue("problem", item.Text & NEW_LINE & NEW_LINE & Problem)
End If
If me_doc.HasItem("DeliveredDate") Then
Set item = me_doc.GetFirstItem( "DeliveredDate" )
Call item.CopyItemToDocument ( NewTicket, "DateCreated")
End If
End If
' Create the unique Number of the ticket
Uniquenumber = Evaluate(|@unique|)
Set item = NewTicket.ReplaceItemValue("ReqNumber",Uniquenumber)
' create the asubject field
asubject = CreateASubject(newticket,"ASubjectMail")
If Isarray( asubject) = True Then
Set item = NewTicket.ReplaceItemValue("ASubject",asubject)
End If
Set item = NewTicket.ReplaceItemValue ("Form", "BugReport")
Set Item = NewTicket.ReplaceItemValue("FormType","Ticket")
Set item = NewTicket.ReplaceItemValue ("Status", "0")
Set item = NewTicket.ReplaceItemValue ("Escalated", "0")
Set item = NewTicket.ReplaceItemValue ("Rerouted", "0")
Set item = NewTicket.ReplaceItemValue ("transformed", "1")
' build the reader and the authors field if necessary
If Ucase(GetConfigDocByKey("LockDocumentsgeneral"))="YES" Then
' create the readers field
namesfield = CreateNamesField(newticket,"LockDocumentsTicketReaders")
If Isarray( namesfield) = True Then
Set item = NewTicket.ReplaceItemValue("AReaders",namesfield)
item.IsReaders = True
End If
' create the authors field
namesfield = CreateNamesField(newticket,"LockDocumentsTicketAuthors")
If Isarray( namesfield) = True Then
Set item = NewTicket.ReplaceItemValue("AAuthors",namesfield)
item.IsAuthors = True
End If
End If
Call NewTicket.Save (True,True)
' Create a mail message because his is a new ticket
' Get the messages for this document
message = GetLanguageStringByKey(GetConfigDocByKey("Language"),"TICKET ACTIONS & STRINGS","msgTicketAssigned")
' split this string search the fields and reconnect it
Messagestringsplit = Split(Message,"~~")
Message = ""
For i = 0 To Ubound(Messagestringsplit) Step 1
messageintern = ""
If messagestringsplit(i) <> "" Then
If Left(messagestringsplit(i),1) = "&" Then
' This is a field get the value of that field
messageintern = itemtextexists(NewTicket,Right(messagestringsplit(i),Len(messagestringsplit(i))-1))
Else
messageintern = messagestringsplit(i)
End If
End If
Message = Message + messageintern
Next
' check if there
' Get the messages for this document
messageclick = GetLanguageStringByKey(GetConfigDocByKey("Language"),"TICKET ACTIONS & STRINGS","msgTicketClick")
' split this string search the fields and reconnect it
Messagestringsplit = Split(Message,"~~")
Messageclick = ""
For i = 0 To Ubound(Messagestringsplit) Step 1
messageintern = ""
If messagestringsplit(i) <> "" Then
If Left(messagestringsplit(i),1) = "&" Then
' This is a field get the value of that field
messageintern = itemtextexists(NewTicket,Right(messagestringsplit(i),Len(messagestringsplit(i))-1))
Else
messageintern = messagestringsplit(i)
End If
End If
Messageclick = Messageclick + messageintern
Next
'is a field that steers mail information sending
If itemTextExists(NewTicket,"fldMailIfNew") = True Then
Set me_notesitem = NewTicket.GetFirstItem("fldMailIfNew")
docmailsend = me_notesitem.text
Else
docmailsend = ""
End If
' doc.form = "BugReport"
' check if the user is a notes user because only this ones get documents with links
Evalstring = |@unique(@NameLookup ( [Exhaustive]; "| + newticket.user(0) + |" ;"FullName"))|
EvalVar = CheckAndEvaluate(Evalstring)
If Isempty(EvalVar) Then
isnotesuser = False
Else
isnotesuser = True
End If
' send the mail either as mail with link or as mail
If Ucase(GetConfigDocByKey ("NoNotification")) = "YES" Or docmailsend = "NO" Or (Ucase(GetConfigDocByKey ("MailIfNewDocDispatcher")) <> "YES" And docmailsend = "")Then
' do not do anything
Else
If Ucase(GetConfigDocByKey ("MailIfNewDocDispatcherLink")) = "YES" And isnotesuser= True Then
BoolLink = True
Else
BoolLink = False
End If
' Send Mail
OK = Spoofmessage(_
GetConfigDocByKey("sendMailonBehalfof"),_
newticket.user, _
newticket.otherusers,_
message,_
messageclick,_
doc,_
"",_
GetConfigDocByKey("MailIfNewDocDispatcherBodyFieldName"),_
BoolLink,_
True,_
"BugReport",_
"IsNewMail")
End If
Createnewticket = newticket.UniversalID
EXITPOINT:
Exit Function
ERRHANDLE:
xProc = Getthreadinfo(LSI_THREAD_PROC)
xError = xProc & ": " &Trim$(Str$(Err)) & " on line " & Cstr(Erl) & ": " & Error$
If UseOpenLog Then
Call LogError
Elseif LogScriptErrors Then
Call ThrowException ( xProc, xError )
End If
Print xError 'In all cases
If ResumeMethodNext Then
Resume Next
Else
Resume EXITPOINT
End If
End Function