Das ist doch eigentlich über die History Class geregelt. Dieser Aufruf funktioniert nicht.... warum auch immer. Im Postopen macht er noch alles korrekt,
In der Datenbank habe ich noch ein älteres Ticket probiert, damit hatte ich keine Probleme, alles okay.
Mittlerweile habe ich aber noch Felder hinzugefügt und noch um Abfragen ergänzt. Insbesondere alles was mit kopieren von Anhängen zu tun hat.
Ich habe das Script im Qureysave ziemlich aufgeblasen. Den Code poste ich jetzt mal noch. Wahrscheinlich ist da auch noch optimierungspotenzial und die zusätzlichen Abfragen können irgendwie zusammengefasst werden.
Ich hatte im Save Button selber auch noch ein Setfield mit dabei, den habe ich aber enfernt.
Sub Querysave(Source As Notesuidocument, Continue As Variant)
Dim session As New NotesSession
Dim wksp As New notesuiworkspace
Dim db As notesdatabase
Dim uidoc As notesuidocument
Dim doc As NotesDocument
Dim messagestext As String
Dim messagessplit As Variant
Dim messageslist List As String
Dim x As Variant
Dim i As Integer
Dim counter As Integer
Dim message As String
Dim messageintern As String
Dim messagestringsplit As Variant
Dim thisdate As New NotesDateTime("")
Dim ok As Boolean
Dim evalvar As Variant
Dim isnotesuser As Boolean
Dim user As String
Dim item As notesitem
Dim evalstring As String
Dim docunid As String
Dim docmailsend As String
Dim notesitem As NotesItem
Redim ErrorArray(0) As String
Set db = session.CurrentDatabase
If source.EditMode = True Then
Call source.RefreshHideFormulas
End If
ValidationArray = Source.Document.SetValidation
Print
If Not ValidateForm(Source.document, ValidationArray, ErrorArray, strGotoField) Then
Msgbox MessageslistitemNotExists(interactivemessages ,"msgValidationDialogheader", 0 ) & Chr$(10) & l_Join(ErrorArray, Chr$(10)),16,MessageslistitemNotExists(interactivemessages ,"msgValidationDialogTitle", 0 )
continue = False
Exit Sub
Else
Call source.refresh
End If
Call thisdate.setnow
user = session.commonUserName
messagestext = source.fieldgettext("MESSAGES")
messagessplit = Split(messagestext,";")
For I = 0 To Ubound(messagessplit) Step 1
x = Split(messagessplit(i),"=")
messageslist(x(0)) = x(1)
Next
If source.Document.input(0) <> "" Then
Ok = logActions(Source,"Useraction","",source.Document.inputtimedate(0), source.Document.inputtimefrom(0),"",source.Document.inputtimeuntil(0),"",Left(source.Document.input(0),100))
If ok = False Then
Print "Error in Module"
continue = False
Exit Sub
End If
If ItemTextExists(source.document, "inputhistory") = False Then
source.Document.inputhistory = source.Document.input(0) & Chr(10) & Chr(13) & Chr(10) & Chr(13) & _
user & " " & thisdate.LocalTime & Chr(10) & Chr(13) &_
"________________________________________" & Chr(10) & Chr(13)
Else
source.Document.inputhistory = source.Document.inputhistory(0) & source.Document.input(0) & Chr(10) & _
user & " " & thisdate.LocalTime & Chr(10) & Chr(13) &_
"________________________________________" & Chr(10) & Chr(13)
End If
source.Document.input = ""
End If
'Zusatz für Überprüfung in der Customer Data tab
If source.Document.inputcd(0) <> "" Then
Ok = logActions(Source,"Useraction","",source.Document.inputtimedate(0), source.Document.inputtimefrom(0),"",source.Document.inputtimeuntil(0),"",Left(source.Document.inputcd(0),100))
If ok = False Then
Print "Error in Module"
continue = False
Exit Sub
End If
If ItemTextExists(source.document, "inputhistoryCD") = False Then
source.Document.inputhistoryCD = source.Document.inputcd(0) & Chr(10) & Chr(13) & Chr(10) & Chr(13) & _
user & " " & thisdate.LocalTime & Chr(10) & Chr(13) &_
"________________________________________" & Chr(10) & Chr(13)
Else
source.Document.inputhistoryCD = source.Document.inputhistoryCD(0) & source.Document.inputcd(0) & Chr(10) & _
user & " " & thisdate.LocalTime & Chr(10) & Chr(13) &_
"________________________________________" & Chr(10) & Chr(13)
End If
source.Document.inputcd = ""
End If
'Zusatz für Überprüfung in der Design Data tab
If source.Document.designdnotes(0) <> "" Then
Ok = logActions(Source,"Useraction","",source.Document.inputtimedate(0), source.Document.inputtimefrom(0),"",source.Document.inputtimeuntil(0),"",Left(source.Document.designnotes(0),100))
If ok = False Then
Print "Error in Module"
continue = False
Exit Sub
End If
If ItemTextExists(source.document, "inputhistoryDD") = False Then
source.Document.inputhistoryDD = source.Document.designdnotes(0) & Chr(10) & Chr(13) & Chr(10) & Chr(13) & _
link & ": " & source.Document.link & Chr(10)& Chr(13)&_
user & " " & thisdate.LocalTime & Chr(10) & Chr(13) &_
"________________________________________" & Chr(10) & Chr(13)
Else
source.Document.inputhistoryDD = source.Document.inputhistoryDD(0) & source.Document.designdnotes(0) & Chr(10) & _
link & ": " & source.Document.link & Chr(10) & Chr(13)&_
user & " " & thisdate.LocalTime & Chr(10) & Chr(13) &_
"________________________________________" & Chr(10) & Chr(13)
End If
source.Document.designdnotes = ""
End If
' Überprüfen ob der Status work in progress gesetzt werden kann. Ist Abhängig vom Feld edrc_number.
'Wenn leer, dann nicht, wenn ja, dann Status setzen.
If source.Document.edrc_number(0) <> "" Then
Set doc = source.Document
Set item = doc.ReplaceItemValue ("in_service", 1)
Call doc.Save(True, True)
Else
Set doc = source.Document
Set item = doc.ReplaceItemValue ("in_service", "")
Call doc.Save(True, True)
End If
'Ist aber der status 99 (Ticket fertig) und Feld edrc_number ist nicht leer, dann Haken entfernen.
If source.Document.status(0) = "99" Then
Set doc = source.Document
Set item = doc.ReplaceItemValue ("in_service", "")
Call doc.Save(True, True)
End If
message = MessageslistitemNotExists(messageslist, "msgTicketAssigned",2)
Set doc = source.Document
If source.IsNewDoc = True Then
If itemTextExists(source.Document,"fldMailIfNew") = True Then
Set notesitem = source.Document.GetFirstItem("fldMailIfNew")
docmailsend = notesitem.text
Else
docmailsend = ""
End If
Evalstring = |@unique(@NameLookup ( [Exhaustive]; "| + Source.Document.user(0) + |" ;"FullName"))|
EvalVar = CheckAndEvaluate(Evalstring, Source.document)
If Isempty(EvalVar) Then
isnotesuser = False
Else
isnotesuser = True
End If
If Ucase(GetConfigDocByKey ("NoNotification")) = "YES" Or docmailsend = "NO" Or (Ucase(GetConfigDocByKey ("MailIfNewDoc")) <> "YES" And docmailsend = "")Then
Else
If Ucase(GetConfigDocByKey ("MailIfNewDocLink")) = "YES" And isnotesuser= True Then
BoolLink = True
Else
BoolLink = False
End If
OK = Spoofmessage(_
GetConfigDocByKey("sendMailonBehalfof"),_
doc.user, _
doc.otherusers,_
message,_
MessageslistitemNotExists(messageslist, "msgTicketClick",2),_
doc,_
GetConfigDocByKey("MailIfNewDocSubjectFieldName"),_
GetConfigDocByKey("MailIfNewDocBodyFieldName"),_
BoolLink,_
True,_
"BugReport",_
"IsNewMail")
End If
End If
If GetConfigDocByKey("RSSCreateFeed") = "YES" Then
ok = createRFCDate(doc,"RFC_822_Date")
End If
If source.IsNewDoc Then
' 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
Set dt1 = New NotesDateTime ( DTCalc.GetNextBusinessDay(Now) )
Set item = doc.ReplaceItemValue ("DTCreated", "")
Set item.DateTimeValue = dt1
End If
End Sub
Sub Queryclose(Source As Notesuidocument, Continue As Variant)
If source.EditMode = True Then
Const TABLE_NAME$ = "$HelpdeskTable"
Const TABLE_TAB$ = "1"
Dim uiws As New NotesUIWorkspace
Dim session As New NotesSession
Dim doc As NotesDocument
Dim uidoc As NotesUIDocument
Set uidoc = uiws.CurrentDocument
Set doc = uidoc.Document
Call doc.ReplaceItemValue(TABLE_NAME, TABLE_TAB)
Dim rtitem As Notesrichtextitem
Dim attachnamedd () As String
Dim attachnamecd () As String
Dim att As Integer
End If
Set g_History = Nothing
' kopieren der Anhänge von attachments aus der design data ins History Feld
Set doc = source.Document
Set rtitem = doc.GetFirstItem( "attachmentdd" )
If (rtitem Is Nothing) Then
Else
att = 0
If ( rtitem.Type = RICHTEXT ) Then
If Isarray (rtitem.embeddedObjects) Then
Forall o In rtitem.EmbeddedObjects
Redim Preserve attachnamedd(att)
attachnamedd(att) = o.Name
att = att + 1
If ( o.Type = EMBED_ATTACHMENT ) Then
Call rtitem.copyItemToDocument (doc, "attachddhistory")
Call o.Remove
Call doc.Save( True, True )
End If
End Forall
Call doc.replaceItemValue("attachddinfo", attachnamedd)
Call doc.save (True,True)
Call uidoc.refresh
End If
Call rtitem.remove
Call doc.save (False, True)
End If
End If
' kopieren der Anhänge von attachments aus der Customer data ins History Feld
Set doc = source.Document
Set rtitem = doc.GetFirstItem( "attachmentcd" )
If (rtitem Is Nothing) Then
Else
att = 0
If ( rtitem.Type = RICHTEXT ) Then
If Isarray (rtitem.embeddedObjects) Then
Forall o In rtitem.EmbeddedObjects
Redim Preserve attachnamecd(att)
attachnamecd(att) = o.Name
att = att + 1
If ( o.Type = EMBED_ATTACHMENT ) Then
Call rtitem.copyItemToDocument (doc, "attachcdhistory")
Call o.Remove
Call doc.Save( True, True )
End If
End Forall
Call doc.replaceItemValue("attachcdinfo", attachnamecd)
Call doc.save (True,True)
Call uidoc.refresh
End If
Call rtitem.remove
Call doc.save (False, True)
End If
End If
End Sub
Ich wäre echt dankbar, wenn jemand den Fehler finden würde.
Thema: Aufruf der Class History beim Querysave funktioniert nicht mehr. (Gelesen 7636 mal)