Ok Jetzt hab ichs. Das Problem ist hier das uidoc.fieldgettext nicht zuverlässig funktioniert. Man muss hier auf eine andere Anweisung ausweichen.
Das hier ist die neue Routine für das Ticket. Beim Todo muss das ebenfalls entsprechend angepasst werden.
Sub Click(Source As Button)
Dim session As New NotesSession
Dim wksp As New notesuiworkspace
Dim db As notesdatabase
Dim uidoc As notesuidocument
Dim doc As NotesDocument
Dim dialogdoc As NotesDocument
Dim messagestext As String
Dim messagessplit As Variant
Dim messageslist List As String
Dim user As String
Dim x As Variant
Dim i As Integer
Dim resubmitnewDocumenthistory As String
Dim message As String
Dim messageintern As String
Dim messagestringsplit As Variant
Dim thisdate As New NotesDateTime("")
Dim ok As Boolean
Dim picklistback As Variant
Dim reroutenewDocumenthistory As String
Dim evalstring As String
Dim evalvar As Variant
Dim isnotesuser As Boolean
Dim notesitem As notesitem
Dim docmailsend As String
Dim userlanguage As String
Dim subformfieldlabels As String
Dim fieldlabelstext As String
Dim fieldlabelssplit As Variant
Dim fieldlabelslist List As String
Dim escalationConfig As String
Dim newescalationdate As New NotesDateTime("")
Dim dateresubmit As String
Dim timeresubmit As String
Dim messageitem As NotesItem
Set db = session.CurrentDatabase
Set uidoc = wksp.CurrentDocument
holders = uidoc.document.LockHolders
If holders(0) <> "" Then
Forall h In holders
lockmessage = lockmessage & h & Chr(13)
End Forall
Messagebox lockmessage,, "Lock holders"
Exit Sub
End If
' if the uidoc is not in editmode set it
If uidoc.EditMode= False Then
uidoc.EditMode=True
End If
' get the actual date
Call thisdate.setnow
' get the actual user
user = session.commonUserName
' build a list for the message strings
messagestext = uidoc.fieldgettext("MESSAGES")
messagessplit = Split(messagestext,";")
For I = 0 To Ubound(messagessplit) Step 1
x = Split(messagessplit(i),"=")
messageslist(x(0)) = x(1)
Next
' build a list for the message strings
fieldlabelstext = uidoc.fieldgettext("FIELDLABELS")
fieldlabelssplit = Split(fieldlabelstext,";")
For I = 0 To Ubound(fieldlabelssplit) Step 1
x = Split(fieldlabelssplit(i),"=")
fieldlabelslist(x(0)) = x(1)
Next
' check if the user really wants to resubmit this ticket or to change the resubmissionDate
If ItemTextExists(uidoc.document, "ResubmittedUntilDate") Then
x =Split(messageslist("msgTicketDReSubmitAgain"),"~")
Else
x =Split(messageslist("msgTicketDReSubmit"),"~")
End If
i= Messagebox(x(1),36,x(0))
If i <> 6 Then
Exit Sub
End If
' open the dialog box to enter some values for the resubmission
' build the message list in the users language
userlanguage = findcurrentuserlanguage
subformfieldlabels = buildlanguageliststring(userlanguage,GetLanguageitem(userlanguage,I_CFGSUBFIELDLABELS))
Set dialogdoc = db.createdocument
dialogdoc.Fieldlabels_Dialog = subformfieldlabels
ok = wksp.DialogBox("ReSubmissionDate",True,True,False,False,False,False,fieldlabelslist("lblTicketToolDialogTitle"),dialogdoc,True)
If ok = True Then
' get the changes from the dialogbox back into the current uidoc
uidoc.document.ResubmittedUntilDate = dialogdoc.fldReSubmissionDate(0)
uidoc.document.ResubmittedUntilTime = dialogdoc.fldReSubmissionTime(0)
' checked all barriers go on and change the document
' set some fields in the uidoc
uidoc.Document.status = "97"
uidoc.document.ResubmittedBy = user
uidoc.document.DateResubmitted = thisdate.LocalTime
' Fetch the values for history
Set notesitem = uidoc.Document.getfirstitem("ResubmittedUntilDate")
DateResubmit = notesitem.Datetimevalue.DateOnly
Set notesitem = uidoc.Document.getfirstitem("ResubmittedUntilTime")
TimeResubmit = notesitem.Datetimevalue.TimeOnly
ResubmitnewDocumentHistory = thisdate.LocalTime + " " + user + " --> " + DateResubmit + "/" + TimeResubmit
If uidoc.Document.ResubmittedHistory(0)<> "" Then
uidoc.Document.ResubmittedHistory = uidoc.Document.ResubmittedHistory(0) + Chr$(10) + Chr$(13) + ResubmitnewDocumentHistory
Else
uidoc.Document.ResubmitHistory = ResubmitnewDocumentHistory
End If
' Check if there is an escalation pending. if so there are three possible reactions. do not touch, touch and set escalation date to resubmission date, touch and set back to no escalation
If uidoc.document.escalated(0) <> "0" Then
EscalationConfig = GetConfigDocByKey("ResubmissionEscalationHandling")
If Escalationconfig = "RESET" Then
' set all escalated values back to zero or in the starting position
uidoc.Document.escalated ="0"
uidoc.Document.escalationDate = ""
uidoc.Document.removeitem("escalationFormula")
uidoc.Document.removeitem("escalationUsedTemplate")
uidoc.Document.removeitem("secondEscalatedTo")
uidoc.Document.removeitem("firstEscalatedTo")
Elseif Escalationconfig = "START" Then
Set newescalationdate = New notesDatetime(DateResubmit + " " + TimeResubmit)
uidoc.Document.escalationDate = newescalationdate
End If
End If
' use the LogActions function for logging entrys.
Ok = logActions(uidoc,"UserResubmitted","",thisdate.Dateonly, thisdate.timeonly,"","","","")
If ok = False Then
' was not assgned due to an error in the logAction Script
Exit Sub
End If
'set the doc
Set doc = uidoc.Document
Call uidoc.Refresh
' check if the user is a notes user because only this ones get documents with links
Evalstring = |@unique(@NameLookup ( [Exhaustive]; "| + uidoc.Document.user(0) + |" ;"FullName"))|
EvalVar = CheckAndEvaluate(Evalstring)
If Isempty(EvalVar) Then
isnotesuser = False
Else
isnotesuser = True
End If
' build the messagestring depending on the defined key
message = messageslist("msgTicketReSubmitted")
' 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
Set messageitem = uidoc.Document.getfirstitem(Right(messagestringsplit(i),Len(messagestringsplit(i))-1))
messageintern = messageitem.text
Else
messageintern = messagestringsplit(i)
End If
End If
Message = Message + messageintern
Next
' check if there is a field that steers mail information sending
If itemTextExists(uidoc.Document,"fldMailIfReSubmitted") = True Then
Set notesitem = uidoc.Document.GetFirstItem("fldMailIfReSubmitted")
docmailsend = notesitem.text
Else
docmailsend = ""
End If
' send a hint to the user who created that ticket
If Ucase(GetConfigDocByKey ("NoNotification")) = "YES" Or docmailsend = "NO" Or (Ucase(GetConfigDocByKey ("MailIfReSubmitted")) <> "YES" And docmailsend = "")Then
' do not do anything
Else
If Ucase(GetConfigDocByKey ("MailIfReSubmittedLink")) = "YES" And Isnotesuser = True Then
BoolLink = True
Else
BoolLink = False
End If
' Send Mail with Message only
OK = Spoofmessage(_
GetConfigDocByKey("sendMailonBehalfof"),_
doc.user, _
doc.otherusers,_
message,_
"",_
doc,_
"",_
GetConfigDocByKey("MailIfResubmittedBodyFieldName"),_
BoolLink,_
True,_
"BugReport",_
"IsResubmittedMail")
End If
Call doc.Save(True,False)
Call uidoc.close
End If
End Sub
