Ich bin ein dummer dummer dummer Bauer.
Ersetz ganz einfach den Code in der lib.notification.resubmission, ProcessReSubmission mit dem hier:
Sub ProcessReSubmission()
On Error Goto ERRHANDLE
%REM
Starting the process of resubmission. There are some base configuration documents that are used to set the path of how this piese of code should work.
ResubmitSetToActive = MANUAL/AUTOMATIC -> if manual the user itself has to set that Status back to a working one. if Automatic this Routine does so.
ResubmitSendRememberingMailSupporter = YES/NO -> send a mail to the Supporter of that particular document
ResubmitSendRememberingMailOwner = YES/NO -> send a mail to the owner of that document. Could be either the Creator (in case of Todos) or the base user
ResubmitSendMailAsSummary = YES/NO -> send each reminder as single mail or as summary mail
ResubmitSendMailBodyFieldName = FieldName -> name of the field that should be included with the body
ResubmitSendMailWithLink = YES/NO -> send a mail with doclink or not (only valid for single mails)
ResubmitDonotSendMailToDefaultSupporter = YES/NO -> if the mail is headed to the default supporter do not send it.
%END REM
Dim session As New notessession
Dim thisdate As New NotesDateTime("")
Dim resubmissionitem As NotesItem
Dim resubmissiondate As New NotesDateTime("")
Dim resubmissiontime As New NotesDateTime("")
Dim founddocuments As NotesDocumentCollection
Dim founddoc As notesdocument
Dim i As Integer
Dim j As Integer
Dim ok As Integer
Dim userlanguage As String
' get the current database
Set me_db =session.CurrentDatabase
' get the language document for messages
userlanguage = findcurrentuserlanguage
Call buildlanguagelist(userlanguage,GetLanguageItem(userlanguage,"ScriptMessages"))
' get the config documents
ResubmitSendMail = Ucase(GetConfigDocByKey("ResubmitSendMail"))
ResubmitSetToActive = Ucase(GetConfigDocByKey ("ResubmitSetToActive"))
ResubmitDefaultStatus = GetConfigDocByKey ("ResubmitDefaultStatus")
ResubmitSendRememberingMailSupporter = Ucase(GetConfigDocByKey ("ResubmitSendRememberingMailSupporter"))
ResubmitSendRememberingMailOwner = Ucase(GetConfigDocByKey ("ResubmitSendRememberingMailOwner"))
ResubmitSendMailAsSummary = Ucase(GetConfigDocByKey ("ResubmitSendMailAsSummary"))
ResubmitSendMailBodyFieldName = Ucase(GetConfigDocByKey ("ResubmitSendMailBodyFieldName"))
ResubmitSendMailWithLink = Ucase(GetConfigDocByKey ("ResubmitSendMailWithLink"))
ResubmitSendMailToDefaultSupporter = Ucase(GetConfigDocByKey ("ResubmitDonotSendMailToDefaultSupporter"))
ResubmitSendMailCheckNames = Ucase(GetconfigDocByKey("ResubmitSendMailCheckNames"))
ResubmitSendMailDefaultSupporter = Ucase(GetconfigDocByKey("DefaultSupporter"))
' get the actual date
Call thisdate.setnow
Set founddocuments = GetActiveResubmissions()
Set founddoc = founddocuments.getfirstdocument
If founddocuments.Count = 0 Then Exit Sub ' nothing to do so far
' Build the list of the users adresses
If Ucase(ResubmitSendMailCheckNames) = "YES" Then
' fetch all valid users from all addressbooks
Call fetchvalidusers(Session)
End If
For i = 1 To founddocuments.Count
Set founddoc = founddocuments.GetNthDocument ( i )
' find if the resubmission date is lowerequal the actual date
Set resubmissionitem = founddoc.GetFirstItem("ResubmittedUntilDate")
Set resubmissiondate = resubmissionitem.DateTimeValue
Set resubmissionitem = founddoc.GetFirstItem("ResubmittedUntilTime")
Set ResubmissionTime = resubmissionitem.DateTimeValue
If resubmissiondate.lslocaltime <= thisdate.LSLocalTime Then
If resubmissiontime.lslocaltime <= thisdate.LSLocalTime Then
' do anything you have to do to inform the users, change the status or what else have ya
ok = GrabOrSendMail(founddoc)
If Ucase(ResubmitSetToActive) = "YES" Then
alldocumentstochangelist(founddoc.UniversalID) = founddoc.UniversalID
End If
End If
End If
Next
' check and send the summary
If Ucase(ResubmitSendMailAsSummary) = "YES" Then
ok = SendResubmitSummary()
End If
If Ucase(ResubmitSetToActive) = "YES" Then
ok = ChangeAllFoundDocuments()
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
und ignoriere was ich vorhin gesagt habe.
Sag ich doch. Dummer Dackel ....
Man sollte nichts rausgeben ohne es selber zu testen. Auch wenn man eigentlich nur mal schnell eben .....
Ok Fix vom Fix.
Sub ProcessReSubmission()
On Error Goto ERRHANDLE
%REM
Starting the process of resubmission. There are some base configuration documents that are used to set the path of how this piese of code should work.
ResubmitSetToActive = MANUAL/AUTOMATIC -> if manual the user itself has to set that Status back to a working one. if Automatic this Routine does so.
ResubmitSendRememberingMailSupporter = YES/NO -> send a mail to the Supporter of that particular document
ResubmitSendRememberingMailOwner = YES/NO -> send a mail to the owner of that document. Could be either the Creator (in case of Todos) or the base user
ResubmitSendMailAsSummary = YES/NO -> send each reminder as single mail or as summary mail
ResubmitSendMailBodyFieldName = FieldName -> name of the field that should be included with the body
ResubmitSendMailWithLink = YES/NO -> send a mail with doclink or not (only valid for single mails)
ResubmitDonotSendMailToDefaultSupporter = YES/NO -> if the mail is headed to the default supporter do not send it.
%END REM
Dim session As New notessession
Dim thisdate As New NotesDateTime("")
Dim resubmissionitem As NotesItem
Dim resubmissiondate As New NotesDateTime("")
Dim resubmissiontime As New NotesDateTime("")
Dim resubmissiondatestring As String
Dim resubmissioncompletedate As NotesDateTime
Dim founddocuments As NotesDocumentCollection
Dim founddoc As notesdocument
Dim i As Integer
Dim j As Integer
Dim ok As Integer
Dim userlanguage As String
' get the current database
Set me_db =session.CurrentDatabase
' get the language document for messages
userlanguage = findcurrentuserlanguage
Call buildlanguagelist(userlanguage,GetLanguageItem(userlanguage,"ScriptMessages"))
' get the config documents
ResubmitSendMail = Ucase(GetConfigDocByKey("ResubmitSendMail"))
ResubmitSetToActive = Ucase(GetConfigDocByKey ("ResubmitSetToActive"))
ResubmitDefaultStatus = GetConfigDocByKey ("ResubmitDefaultStatus")
ResubmitSendRememberingMailSupporter = Ucase(GetConfigDocByKey ("ResubmitSendRememberingMailSupporter"))
ResubmitSendRememberingMailOwner = Ucase(GetConfigDocByKey ("ResubmitSendRememberingMailOwner"))
ResubmitSendMailAsSummary = Ucase(GetConfigDocByKey ("ResubmitSendMailAsSummary"))
ResubmitSendMailBodyFieldName = Ucase(GetConfigDocByKey ("ResubmitSendMailBodyFieldName"))
ResubmitSendMailWithLink = Ucase(GetConfigDocByKey ("ResubmitSendMailWithLink"))
ResubmitSendMailToDefaultSupporter = Ucase(GetConfigDocByKey ("ResubmitDonotSendMailToDefaultSupporter"))
ResubmitSendMailCheckNames = Ucase(GetconfigDocByKey("ResubmitSendMailCheckNames"))
ResubmitSendMailDefaultSupporter = Ucase(GetconfigDocByKey("DefaultSupporter"))
' get the actual date
Call thisdate.setnow
Set founddocuments = GetActiveResubmissions()
Set founddoc = founddocuments.getfirstdocument
If founddocuments.Count = 0 Then Exit Sub ' nothing to do so far
' Build the list of the users adresses
If Ucase(ResubmitSendMailCheckNames) = "YES" Then
' fetch all valid users from all addressbooks
Call fetchvalidusers(Session)
End If
For i = 1 To founddocuments.Count
Set founddoc = founddocuments.GetNthDocument ( i )
' find if the resubmission date is lowerequal the actual date
Set resubmissionitem = founddoc.GetFirstItem("ResubmittedUntilDate")
Set resubmissiondate = resubmissionitem.DateTimeValue
Set resubmissionitem = founddoc.GetFirstItem("ResubmittedUntilTime")
Set ResubmissionTime = resubmissionitem.DateTimeValue
Set resubmissioncompletedate = New NotesDateTime(resubmissiondate.DateOnly + " " + resubmissiontime.TimeOnly)
If resubmissioncompletedate.lslocaltime <= thisdate.LSLocalTime Then
' do anything you have to do to inform the users, change the status or what else have ya
ok = GrabOrSendMail(founddoc)
If Ucase(ResubmitSetToActive) = "YES" Then
alldocumentstochangelist(founddoc.UniversalID) = founddoc.UniversalID
End If
End If
Next
' check and send the summary
If Ucase(ResubmitSendMailAsSummary) = "YES" Then
ok = SendResubmitSummary()
End If
If Ucase(ResubmitSetToActive) = "YES" Then
ok = ChangeAllFoundDocuments()
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
Und Ey Alder isch schwörz. Ischt escht brontal geteschted.
Naja zumindest einmal .....