Wenn du es testest und es dann sicher funktioniert. bauen wir das in die Version 2.0 noch mit ein....
Ersetze mal in der Lib.appl.function den Code für "CreateNewTicket" durch das hier ....
Function CreateNewTicket(db As NotesDatabase, me_doc As notesdocument) As String
%REM
###################################################################################
Goal: This function creates a new Ticket from a mailed document
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Arguments: Description:
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
2.0/17.02.2009/Thomas Schulte/added new config document for copying defineable items from memo documents to the ticket
'###################################################################################
%END REM
On Error Goto ERRHANDLE
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 dispstatus As String
'added for the purpose of copying user defined items from the mail source to the ticket target
Dim MailNewDocCopyItems As String
Dim MailCopyItemsVariant As Variant
'End new part
Dim v1 As Variant
Dim i As Integer
Const NEW_LINE = Uchr$(13)
' fetch the new config document
MailnewDocCopyItems = GetConfigDocByKeyMultiValue("DispatcherItemsToCopyFromMail",";")
If MailnewDocCopyItems <> "" Then
MailCopyItemsVariant = Split(MailnewDocCopyItems,";")
End If
'End new part
createnewticket = ""
Set NewTicket = New NotesDocument( db )
If Ucase(me_doc.form(0)) = "NEWBUGREPORT" Then
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
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
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
If me_doc.HasItem("$Mailer") Then
Set item = me_doc.GetFirstItem( "$Mailer" )
Call item.CopyItemToDocument ( NewTicket, "fromMailSystem")
End If
' go through all the other defined items and copy them
If MailnewDocCopyItems <> "" Then
Forall v In MailCopyItemsVariant
v1 = Split(v,"~")
If me_doc.HasItem(v1(0)) Then
Set item = me_doc.GetFirstItem( v1(0) )
Call item.CopyItemToDocument ( NewTicket, V1(1))
End If
End Forall
End If
' end new part
End If
Uniquenumber = Evaluate(|@unique|)
Set item = NewTicket.ReplaceItemValue("ReqNumber",Uniquenumber)
asubject = CreateASubject(newticket,"ASubjectTicket")
If Isarray( asubject) = True Then
Set item = NewTicket.ReplaceItemValue("ASubject",asubject)
End If
asubject = CreateASubject ( newticket, "AInfoTicket" )
If Isarray( asubject) = True Then
Set item = NewTicket.ReplaceItemValue("AInfo",asubject)
End If
Set item = NewTicket.ReplaceItemValue ("Form", "BugReport")
Set item = NewTicket.ReplaceItemValue ("FormID", "1")
Set Item = NewTicket.ReplaceItemValue("FormType","Ticket")
dispstatus = GetConfigDocByKey("DispatcherNewTicketStartStatus")
If Dispstatus = "" Then Dispstatus = "0"
Set item = NewTicket.ReplaceItemValue ("Status", DispStatus)
Set item = NewTicket.ReplaceItemValue("enteredBy","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
' The following code will calculate the next business day according to @now
Dim EXCLUDE_DAYS As String
Dim EXCLUDE_DATES As String
Dim SERVICEHOURS As String
Dim conf As New Config
EXCLUDE_DAYS = conf.GetSingleValue ("DTC_EXCLUDE_DAYS")
EXCLUDE_DATES = conf.GetSingleValue ("DTC_EXCLUDE_DATES")
SERVICEHOURS = conf.GetSingleValue ("DTC_SERVICEHOURS")
Dim DTCalc As New DateTimeCalculator (EXCLUDE_DAYS,EXCLUDE_DATES,SERVICEHOURS)
Dim dt1 As NotesDateTime
If me_doc.HasItem ("DateCreated") Then
Set item = me_doc.GetFirstItem( "DateCreated" )
Elseif me_doc.HasItem ("ComposedDate") Then
Set item = me_doc.GetFirstItem( "ComposedDate" )
Else
Set item = me_doc.GetFirstItem( "DeliveredDate" )
End If
Set dt1 = New NotesDateTime ( DTCalc.GetNextBusinessDay(item.Text) )
Set item = NewTicket.ReplaceItemValue ("DTCreated", "")
Set item.DateTimeValue = dt1
Call NewTicket.Save (True,True)
message = GetLanguageStringByKey(GetConfigDocByKey("Language"),"TICKET ACTIONS & STRINGS","msgTicketAssigned")
' Get the messages for this document
messageclick = GetLanguageStringByKey(GetConfigDocByKey("Language"),"TICKET ACTIONS & STRINGS","msgTicketClick")
'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
' 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, newticket)
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
Else
If Ucase(GetConfigDocByKey ("MailIfNewDocDispatcherLink")) = "YES" And isnotesuser= True Then
BoolLink = True
Else
BoolLink = False
End If
OK = Spoofmessage(_
GetConfigDocByKey("sendMailonBehalfof"),_
newticket.user, _
newticket.otherusers,_
message,_
messageclick,_
doc,_
GetConfigDocByKey("MailIfNewDocDispatcherSubjectFieldName"),_
GetConfigDocByKey("MailIfNewDocDispatcherBodyFieldName"),_
BoolLink,_
True,_
"BugReport",_
"IsNewMail")
End If
Createnewticket = newticket.UniversalID
EXITPOINT:
Exit Function
ERRHANDLE:
Call LogError
Resume EXITPOINT
End Function
Anschließend baust du in neues Konfigurationsdokument in die Konfiguration ein.
Dann testest du den Dispatcher auf deinem Testsystem. Einmal Ohne Werte im Configurationsdokument.
Einmal mit irgendwelchen PseudoFeldnamen.
Und wenn das alles funktioniert dann sagst du eurem Helpdesk Bescheid.
Uns natürlich auch, dann können wir das einbauen.
Thema: Feldnamen aus eingehender Mail übernehmen (Gelesen 4405 mal)