wenn ich über Ticket DVSR-DJGFD3 rede, aber jeder versteht mich, wenn ich sage, "hast Du OP 592 schon bearbeitet?".... - Vorallem mit unseren externen Supportern, die keinen direkten HELP Zugang haben und über Aufgaben- bzw. Ticketmails kommunizieren. O0Also bei uns funktioniert das ....
Also bei uns funktioniert das ....
Aber ich versteh dich da schon, irgendwie, ein wenig, vielleicht .....
Nur für das Wiederfinden im Dispatcher werden wir das nie nutzen. Deswegen MUSS die "kryptische" Nummer immer im Betreff stehen bleiben und ob dann eine Fortlaufend Nummer richtig viel Sinn macht??
Ich hatte ja angekündigt, dass ich mich mit der Implementierung von erweiterten Systeminformationen in das neue Release beschäftige.Ist es dann auch möglich bei Terminal-Server-Betrieb die Systeminformationen des lokalen Clients auszulesen?
'///////////////////////////////////////////////////////////////////
Private Class Stamp
'-------------------------------------------------------------------
%REM
represents a single stamp in the multi-value field "nStampAll"
%END REM
Public strStampField As String
Public strStampValue As String
End Class
'-------------------------------------------------------------------
'///////////////////////////////////////////////////////////////////
Private Class Recipient
'-------------------------------------------------------------------
%REM
represents a single receipient in the multi-value field "nFirstEscalationSendTo"
%END REM
Public strRecipientName As String
Public strRecipientLanguage As String
End Class
'-------------------------------------------------------------------
'///////////////////////////////////////////////////////////////////
Private Class Profile
'-------------------------------------------------------------------
%REM
represents a single document from a collection of all active escalation-profiles
%END REM
Public boolProfileStatus As Boolean
Public strProfileDescription As String
Public strProfileTemplate As String
Public strProfileFormula As String
Public colProfileSingleFieldStamp () As Stamp
Public colProfileSingleRecipient () As Recipient
End Class
'-------------------------------------------------------------------
'///////////////////////////////////////////////////////////////////
Private Class ProfileCollection
'-------------------------------------------------------------------
%REM
represents a collection of all active escalation-profiles
%END REM
Public intpColCount As Integer
'Public colProfileCollectionSingleProfile () As Profile
End Class
'-------------------------------------------------------------------
'///////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////
Public Class HelpEscalationProfileCollection
'///////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////
Private pCol As ProfileCollection
Public Sub New ()
'------------- ON ERROR STUFF -------------------
On Error Goto ERRHANDLE
'------------- DIM STUFF-----------------------------
Dim s As New NotesSession
Dim col As NotesDocumentCollection
Dim dt As New NotesDateTime(Cstr(Datenumber(2004, 5, 1)))
Dim T_Col As New ProfileCollection
'------------- SET STUFF-----------------------------
Set col = s.CurrentDatabase.Search ({@UpperCase(Form) = "NOTIFICATION PROFILE" & nStatus = "1"} , dt, 0 )
T_Col.intpColCount = col.Count
Set pCol = T_Col
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
Public Property Get Count () As Integer
count = Me.pCol.intpColCount
End Property
End Class Dim engine As New EscalationEngine
Call engine.Run
'///////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////
Public Class EscalationEngine
'///////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////
Private pCol As NotesDocumentCollection
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/* CONSTRUCTOR
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Public Sub New ()
On Error Goto ERRHANDLE
Dim s As New NotesSession
Dim dt As New NotesDateTime(Cstr(Datenumber(2004, 5, 1)))
Set pCol = s.CurrentDatabase.Search ({@UpperCase(Form) = "NOTIFICATION PROFILE" & nStatus = "1"} , dt, 0 )
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
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Private Function TicketCollection ( idx As Integer ) As NotesDocumentCollection
On Error Goto ERRHANDLE
Dim s As New NotesSession
Dim dt As New NotesDateTime(Cstr(Datenumber(2004, 5, 1)))
Set TicketCollection = s.CurrentDatabase.Search (Me.pCol.GetNthDocument ( idx ).nFormula(0) , dt, 0 )
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 Recipients ( idx As Integer ) As Variant
On Error Goto ERRHANDLE
Recipients = Me.pCol.GetNthDocument ( idx ).nFirstEscalationSendTo
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 SetField ( idx As Integer ) As Variant
On Error Goto ERRHANDLE
SetField = Me.pCol.GetNthDocument ( idx ) .nStampAll
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 Sub StampAll ( idx As Integer )
On Error Goto ERRHANDLE
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 ( idx )
varStampValues = Me.SetField ( idx )
If Trim ( varStampValues (0) ) ="" Then
Exit Sub ' nothing to do; let's get outa here
Else
strColDocFieldFound = Left$ ( strStampFieldWith , 2 ) ' <<TAG>>
Forall v In varStampValues
strFieldToStamp = Trim(Strtoken ( Cstr ( v ) , "|" , 1 ))
strStampFieldWith = Trim(Strtoken ( Cstr ( v ) , "|" , 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
End Forall
End If
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
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Public Sub Run
' put stuff here
Me.StampAll ( 1 )
End Sub
End Class
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
Set TicketCollection = s.CurrentDatabase.Search (Me.pCol.GetNthDocument ( idx ).nFormula(0) , dt, 0 )
If IsEmpty ( varStampValues) Then
Exit Sub ' nothing to do; let's get outa here
und wer eine Idee hat, wie man das immer wiederkehrendeCodeEXITPOINT: 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
ersetzen kann, ohne den Fokus auf die Routine zu verlieren, der möge das bitte hier posten ...
Class TagArray
Public Tag () As String
End Class
'///////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////
Public Class EscalationEngine
'///////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////
Private pCol As NotesDocumentCollection
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%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 col As NotesDocumentCollection
Dim ta As TagArray
SendNotifications = False
If epd.HasItem ( "SendAsSummary" ) Then
If epd.SendAsSummary(0) = 1 Then
SendAsSummary = True
End If
End If
Set col = Me.TicketCollection ( epd )
strTemplateName = epd.nTemplate(0)
' Hier jetzt ein Loop durch col
Forall r In epd.nFirstEscalationSendTo
strRecipientName = Trim(Strtoken ( Cstr ( r ) , "|" , 1 ))
strRecipientLanguage = Trim(Strtoken ( Cstr ( r ) , "|" , 2 ))
Set ta = New TagArray
%REM
ToDo
Was haben wir bis jetzt ? ( SendAsSummary lassen wir mal ausser 8 )
Name des Templates und Sprache des Empfängers.
Jetzt hole dir das Template in der richtigen Sprache ( prüfen, ob überhaupt vorhanden )
Fülle das TagArray mit den <<>> Tags des Template und übergebe den Kram mitsamt des Template Body an
Private Function ModifyMessageText ( TemplateBody As NotesRichTextItem, Tags As TagArray ) As NotesRichTextItem
Du bekommst ein RT mit dem MessageText zurück .
Prüfe ob @Contains strRecipientName < --> hänge doclink an MessageText und raus damit.
sonst baue Newsletter aller Tickets aus col und hänge den stuff an MessageText -- raus damit
%END REM
End Forall
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
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Private Function ModifyMessageText ( TemplateBody As NotesRichTextItem, Ticket as NotesDocument, Tags As TagArray ) As NotesRichTextItem
On Error Goto ERRHANDLE
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
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/* CONSTRUCTOR
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Public Sub New ()
On Error Goto ERRHANDLE
Dim s As New NotesSession
Dim dt As New NotesDateTime(Cstr(Datenumber(2004, 5, 1)))
Set pCol = s.CurrentDatabase.Search ({@UpperCase(Form) = "NOTIFICATION PROFILE" & nStatus = "1"} , dt, 0 )
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
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Private Function TicketCollection ( epd As NotesDocument ) As NotesDocumentCollection
On Error Goto ERRHANDLE
Dim s As New NotesSession
Dim dt As New NotesDateTime(Cstr(Datenumber(2004, 5, 1)))
Set TicketCollection = s.CurrentDatabase.Search ( epd.nFormula( 0 ) , dt, 0 )
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 ) , "|" , 1 ))
strStampFieldWith = Trim(Strtoken ( Cstr ( v ) , "|" , 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 ret As Boolean
Dim epd As NotesDocument
For i = 1 To Me.pCol.count
Set epd = Me.pCol.GetNthDocument ( i )
If Not Me.StampAll ( epd ) Then Exit Sub ' set field values
If Not Me.SendNotifications ( 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
1. Wir haben hier im Haus ca. 100 Anwendungen, die wir Supporten müssen. Das bisherige Ticket-Tool, dass wir jetzt mit HELP ablösen,hatte (neben vielen, vielen Nachteilen) den Vorteil, daß bei der Supporterzuweisung die Anwendung berücksichtigt wurde.Hmm das hatten wir als Anforderung schon einmal. Das Problem das sich dann stellt ist wie krieg ich das dynamisch hin und vor allen wo soll es denn eingebaut werden. Immer bei der Zuweisung? Nur bei neuen Dokumenten? Soll der Benutzer immer zweimal klicken müssen? Bis zu einem gewissen Grad kann man das denke ich jetzt schon lösen, wenn man kein Addressbuch als Quelle für die Supporter nutzt, sondern die eingebaute Supporter Funktion "LUPNAMES = custom"und dann die Einträge für die Supporter mit den entsprechenden Schüsseln versieht
2. Bei der Anwendungsauswahl, vorallem wenn man alle 3 Ebenen nutzt, wäre eine Tree-Auswahl besser als die jetzt abhängigen Textfelder. Man findet sich eben leichter zurecht. Vielleicht auch als extra Knopf für ein Tree-Fenster, daß dann die Textfelder füllt.Was ist an einer Tree View besser? Außerdem sind die hinterlegten Schlüssel nicht statisch aufeinander aufgebaut, sondern können dynamisch voneinander abhängig gemacht werden. Oder auch nicht wenn man will. Damit fallen schon mal die "einfachen" Möglichkeiten so einen Tree aufzubauen weg.
3. Bei der Lösungsdatenbank kann man nur die 1. Ebene der Anwendung kategorisieren, das reicht meistens nicht aus, besser wäre die Nutzungsmöglichkeit aller 3 Ebenen der Anwendung.Ehrlich!!! Ihr verwendet die Technotes??? Die sind eigentlich noch überhaupt nicht vernünftig eingebunden in das System. Streng genommen noch gar nicht.
4. Bei den Aktionen sollte per default aktuelles Datum und Uhrzeit gefüllt werden, geht dann erheblich schneller.Haben wir Hausintern schon ein paarmal diskutiert. Und hatten es auch schon eingebunden. Das Ergebniss war das sich 90% beschwert haben das man ja jedesmal die Werte wieder löschen muss wenn man da was anderes einträgt oder wenn man nur kurz mal eine Systemaktion durchgeführt hat. Das kam nicht so gut an. Was gehen würde wäre einen Flag beim Öffnen des Dokumentes zu setzen und einen Button um die Zeiten einzutragen. Das überleg ich mir mal.
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
Ehrlich!!! Ihr verwendet die Technotes??? Die sind eigentlich noch überhaupt nicht vernünftig eingebunden in das System. Streng genommen noch gar nicht.
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Send a notification summary
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Private Function BuildAndSendMessageAsSummary ( Template As NotesDocument,_
tCol As NotesDocumentCollection, rcpt As String , group As Boolean) As Boolean
Dim UniqueRcpt As Variant
Dim sCol As NotesDocumentCollection
On Error Goto ERRHANDLE
BuildAndSendMessageAsSummary = False
If ( Not group) Then
'regular stuff here
If Left ( rcpt, 1 ) = "<" Then
' ERROR : A summary can only be send to a single recipient or a group from DD
' Throw exception and stop executing
Goto EXITPOINT
Else
' rcpt does not contain a << tag;
' append a list of doclinks to the template and send it to the rcpt
'
End If
Else
' weird stuff here
If ( Not Left ( rcpt, 1 ) = "<" ) Then
' absolutely weird, does not belong here but can be handeld
Else
' remove <<tag>> from rcpt
' ... code to remove <<tags>> here ...
UniqueRcpt = Me.UniqueItems ( tcol , rcpt )
Forall r In UniqueRcpt
sCol = Me.SubCollection ( tCol , icstr ( r ) )
' now send the collection to the UniqueRcpt
End Forall
End If
End If
BuildAndSendMessageAsSummary = True
EXITPOINT:
Exit Function
ERRHANDLE:
Dim e As New Exception
xProc = Getthreadinfo(LSI_THREAD_PROC)
xError = xProc & ": " &Trim$(Str$(Err)) & " on line " & Cstr(Erl) & ": " & Error$
If e.es.UseOpenLog Then
Call LogError
Elseif e.es.LogScriptErrors Then
Call ThrowException ( xProc, xError )
End If
Print xError 'In all cases
If e.es.ResumeMethodNext Then
Resume Next
Else
Resume EXITPOINT
End If
End Function
function Send ( tCol as NotesDocumentCollection, rcpt as String, TemplateBody as NotesRichTextItem ) as booleanAh ja gefunden und gefixt. Wenn man jetzt Änderungen im RTFeld durchführt werden die auch mit übergeben. (In der nächsten Version). Das ist ein klassisches Ällerbätsch von Notes. Änderungen von RTFeldern in Dialogboxen werden eigentlich nicht an den aufrufenden Code übergeben. Es sei denn man zaubert ein wenig. Gut jetzt haben wir dank der Hilfe eines guten Freundes gezaubert. Und jetzt funktioniert das auch.