Lotus Notes / Domino Sonstiges > Help-Desk Applikation !!Help!!
Änderungen und Fixes im nächsten point Release 1.5.1 von !!Help!!
eknori (retired):
Hier noch einmal für die Chronisten der Code der EscalationEngine.
Mehr habe ich an meinem 7. Hochzeitstag nicht geschafft ;D ... Sachzwänge ...
Wer Lust hat, kann das ja mal testen ... ( dass ist nix für noobs ! )
--- Code: ---Const TAG_PIPE = "|"
'///////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////
Public Class EscalationEngine
'///////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////
Private pCol As NotesDocumentCollection
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Returns a collection of active notification profiles
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Public Sub New ()
Set pCol = Me.GetSearchResult ( {@UpperCase(Form) = "NOTIFICATION PROFILE" & nStatus = "1"} )
End Sub
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Returns a collection of Tickets matching the search formula from the escalation profile
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Private Function TicketCollection ( epd As NotesDocument ) As NotesDocumentCollection
Set TicketCollection = Me.GetSearchResult ( epd.nFormula ( 0 ) )
End Function
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Return a collection of documents matching a search formula
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Private Function GetSearchResult ( SearchFormula As String ) As NotesDocumentCollection
Dim s As New NotesSession
Dim dt As New NotesDateTime ( Cstr(Datenumber ( 2004, 5, 1 ) ) )
Set GetSearchResult = s.CurrentDatabase.Search ( SearchFormula , dt, 0 )
End Function
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Sends notifications to a single recipient or to group of recipients; The message can be send in different languages
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Private Function SendNotifications ( epd As NotesDocument ) As Boolean
On Error Goto ERRHANDLE
Dim SendAsSummary As Boolean
Dim strTemplateName As String
Dim strRecipientName As String
Dim strRecipientLanguage As String
Dim i As Integer
Dim col As NotesDocumentCollection
Dim Template As NotesDocument
Dim Ticket As NotesDocument
Dim rtiTemplateBody As NotesRichTextItem
Dim rtMessage As NotesRichTextItem
SendNotifications = False
If epd.HasItem ( "SendAsSummary" ) Then ' to avoid errors with epd where field is not available
If epd.SendAsSummary(0) = 1 Then
SendAsSummary = True
End If
End If
Set col = Me.TicketCollection ( epd )
If SendAsSummary Then ' available in 1.5.1
%REM
'Add Code
%END REM
Else
For i = 1 To col.Count ' Loop thru ticket collection
Set Ticket = col.GetNthDocument ( i )
' For each ticket get the list of recipients
Forall r In epd.nFirstEscalationSendTo
' get a single recipient; can be <<TAG>>, single Name or a group.
strRecipientName = Trim ( Strtoken ( Cstr ( r ) , TAG_PIPE , 1 ) )
If Left ( strRecipientName, 1 ) = "<" Then
' r contains format "<<tag>> | language"
Dim item As NotesItem
Set item = Ticket.GetFirstItem ( Trim ( Mid ( strRecipientName, 3, Len ( strRecipientName ) - 4 ) ) )
strRecipientName = Item.Text
End If
strRecipientLanguage = Trim (Strtoken ( Cstr ( r ) , TAG_PIPE , 2 ) )
' get the language specific template
Set Template = Me.GetTemplate ( Ucase ( epd.nTemplate ( 0 ) ), Ucase ( strRecipientLanguage ) )
' build the message; replaces all <<TAGS>> with values from ticket
Set rtMessage = Me.BuildMessage ( Template , Ticket )
' finally send the message
End Forall
Next
End If
EXITPOINT:
SendNotifications = True
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
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Get the template accoording to the field nTemplate in the notification profile
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Private Function GetTemplate ( strTemplateName As String, strLanguage As String ) As NotesDocument
On Error Goto ERRHANDLE
Dim col As NotesDocumentCollection
If strLanguage = "" Or strTemplateName= "" Then
Set GetTemplate = Nothing
Goto EXITPOINT
Else
Set col =_
Me.GetSearchResult (_
{@UpperCase(Form) = "CONFIGMAILTEMPLATE"} &_
{ & @UpperCase(cfgKey) = "} & strTemplateName &{"} &_
{ & @UpperCase(cfgLanguage) = "} & strLanguage &{"} )
If col.Count > 0 Then
Set GetTemplate = col.GetFirstDocument
End If
End If
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
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Private Function BuildMessage ( Template As NotesDocument , Ticket As NotesDocument ) As NotesRichTextItem
On Error Goto ERRHANDLE
Dim rtnav As NotesRichTextNavigator
Dim rtrange As NotesRichTextRange
Dim strTemp As String
' replace all <<tags>> with values from ticket
' append doclink to RTItem
' want to send info 'bout child docs, too ??
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
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Private Function StampAll ( epd As NotesDocument ) As Boolean
On Error Goto ERRHANDLE
StampAll = False
Dim s As New NotesSession
Dim dt As New NotesDateTime(Cstr(Datenumber(2004, 5, 1)))
Dim varStampValues As Variant
Dim strFieldToStamp As String
Dim strStampFieldWith As String
Dim strAtAdjust As Variant
Dim strColDocFieldFound As String
Dim atNow As New NotesDateTime( Now )
Dim thisdate As New NotesDateTime("")
Call thisdate.setnow
Dim col As NotesDocumentCollection
Set col = Me.TicketCollection ( epd )
varStampValues = epd.nStampAll
If Trim ( varStampValues (0) ) ="" Then
Exit Function ' nothing to do; let's get outa here
Else
strColDocFieldFound = Left$ ( strStampFieldWith , 2 ) ' <<TAG>>
Forall v In varStampValues
strFieldToStamp = Trim(Strtoken ( Cstr ( v ) , TAG_PIPE , 1 ))
strStampFieldWith = Trim(Strtoken ( Cstr ( v ) , TAG_PIPE , 2 ))
If Left$ ( strStampFieldWith , 1 ) = "@" Or strColDocFieldFound = "<<" Then
If Instr ( Ucase ( strStampFieldWith ) , "@ADJUST") Then
strAtAdjust = Split ( strStampFieldWith , ";")
strStampFieldWith = Left ( Ucase ( strStampFieldWith ) , 7 )
End If
Select Case Ucase ( strStampFieldWith )
Case "@NOW"
strStampFieldWith = Cstr(Now)
Case "@DATE(@NOW)"
strStampFieldWith = Cstr(atNow.DateOnly)
Case "@TIME(@NOW)"
strStampFieldWith = Cstr(atNow.TimeOnly)
Case "@ADJUST"
Call thisdate.AdjustYear( Cint(strAtAdjust(1)) )
Call thisdate.AdjustMonth( Cint(strAtAdjust(2)) )
Call thisdate.AdjustDay( Cint(strAtAdjust(3)) )
Call thisdate.AdjustHour( Cint(strAtAdjust(4)) )
Call thisdate.AdjustMinute( Cint(strAtAdjust(5)) )
Call thisdate.AdjustSecond( Cint(Left(strAtAdjust(6),1)) )
strStampFieldWith = Cstr(thisdate.LocalTime)
End Select
End If
Call col.StampAll ( strFieldToStamp, strStampFieldWith )
End Forall
End If
EXITPOINT:
StampAll = True
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
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/* MAIN METHOD
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Public Sub Run ()
On Error Goto ERRHANDLE
Dim i As Integer
Dim epd As NotesDocument
For i = 1 To Me.pCol.count
Set epd = Me.pCol.GetNthDocument ( i )
If Not Me.SendNotifications ( epd ) Then Exit Sub
If Not Me.StampAll ( epd ) Then Exit Sub
Next
EXITPOINT:
Exit Sub
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 Sub
End Class
--- Ende Code ---
Lauff:
--- Zitat ---Ehrlich!!! Ihr verwendet die Technotes??? Die sind eigentlich noch überhaupt nicht vernünftig eingebunden in das System. Streng genommen noch gar nicht.
--- Ende Zitat ---
Schade eigendlich. Aber version 2.0 kommt ja auch irgendwann ;)
dudeis:
Bei uns passierte folgendes:
wenn mit "SpoofMessage" eine Antwortmail generiert wurde, dann wurde die Änderung im Body nicht mitgesendet. D.h. egal was man eingetragen hat, es wurde immer der Original Lösungstext geschickt.
In der Notes Hilfe zur Methode NotesUIWorkspace.Dialogbox steht :
Field sharing is not supported for rich text fields.
Also habe ich in der Maske "ShowMail" beim Feld "Body" den Typ von "Rich Text" auf "Text" geändert. => siehe da es geht !
Kennt Ihr vielleicht alternative Lösungen ? Ansonsten sollte man das wohl für weitere Releases berücksichtigen !
Thomas Schulte:
@dudeis ?????
Kannst du das bitte etwas genauer beschreiben. Spoofmessage und der Austausch der entsprechenden Daten läuft eigentlich ohne Probleme.
dudeis:
Hallo Thomas,
wenn ich z.B. eine Anfrage erledigt habe, dann wird eine Antwort an den User mit dem Lösungstext erzeugt.
Wenn ich in dem Dialog für die Mailantwort den Text ändere oder lösche, dann werden die Änderungen nicht an den User gemailt, sondern es kommt der unveränderte Text an.
Ich beziehe mich auf die Function Spoofmessage in der Library "lib.appl.function" von Version 1.5.0.
Ich hoffe, dass ich hier die richtigen Codestellen rausgepickt habe :
Es wird ein Richtextitem erzeugt:
(Zeile 158)
Set rtitem = showmaildoc.CreateRichTextItem( "Body" )
das Item wird z.B. mit dem Lösungstext gefüllt (Inhalt des Parameters "message"):
(Zeile 175)
Call rtitem.AppendText( message )
Später wird der Dialog mit der Maske "ShowMail" angezeigt:
(Zeile 184)
Dim wksp As New notesuiworkspace
ok = wksp.dialogbox("ShowMail",True,True,True,True,False,False,"",showmaildoc)
zum Debuggen habe ich anschließend folgende Zeile eingefügt:
Set me_item = showMailDoc.GetFirstItem("Body")
Messagebox me_item.text
Hier wird (bei mir !?) der unveränderte Lösungstext angezeigt, welcher dann auch per Mail verschickt wird.
Wird aber in der Maske "ShowMail" beim Feld "Body" anstelle des Typs "RichText" als Typ "Text" verwendet, dann funktioniert es !
Reicht Dir das als Info ?
Ich gehe mal davon aus, dass ich bei uns nichts fehlkonfiguriert habe.
Viele Grüße,
Andreas
Navigation
[0] Themen-Index
[#] Nächste Seite
[*] Vorherige Sete
Zur normalen Ansicht wechseln