Regeln im Mailfile

Sub Initialize
	Dim s As New NotesSession
	Dim db As NotesDatabase
	Dim viwRules As NotesView
	Dim vecRules As NotesViewEntryCollection
	Dim veRule As NotesViewEntry
	Dim docRule As NotesDocument
	Dim docProfile As NotesDocument


	Dim dxlExporter As NotesDXLExporter
	Dim stream As NotesStream


	Dim varProfileCount As Variant
	Dim intProfileCount As Integer
	Dim intProfileItemCount As Integer
	Dim intRulesCount As Integer

	Dim intMax As Integer
	Dim i As Integer

	Dim lstFilterFormulas List As String

	Dim varFilterFormulas As Variant
	Dim strFilterNr As String
	Dim strFormula As String

	Dim arrConditions() As String
	Dim arrActions() As String
	Dim arrRuleNr() As String
	Dim arrProfileEntries() As String


	Dim ws As New NotesUIWorkspace
	Dim docDialog As NotesDocument

	On Error GoTo ErrHandler

	Set db=s.currentdatabase
	Set viwRules=db.getview("Rules")
	Set vecRules=viwRules.allentries
	intRulesCount = vecRules.Count
	Set docProfile=db.GetProfileDocument("CalendarProfile")

	Set stream = s.Createstream()
	Set dxlExporter = s.Createdxlexporter(docProfile, stream) '- Formula- Felder müssen über DXL ausgelesen werden, anders kommt man nicht ran
	Call dxlExporter.Process()


	varFilterFormulas = Split( stream.Readtext , "<item name='$FilterFormula_" ) '- Pos 0 ist uninteressant, alle Werte danach sind wichtig
	If UBound( varFilterFormulas ) > 0 Then
		intProfileItemCount = 0
		ForAll strFilterFormula In varFilterFormulas
			If intProfileItemCount > 0 Then '- das 0. interessiert noch nicht
				strFilterNr = StrLeft( strFilterFormula , "'" )
				strFormula = StrLeft( StrRight( strFilterFormula , "<formula>" ) , "</formula>" )
				If strFormula <> "" Then
					lstFilterFormulas( strFilterNr ) = Replace( strFormula, Chr$(13)&Chr$(10) , " ")
				End If
			End If
			intProfileItemCount = intProfileItemCount + 1
		End ForAll
		intProfileItemCount = intProfileItemCount - 1 '- wieder um 1 reduzieren, weil das 0. Element ignoriert wurde
	End If

	varProfileCount = docProfile.GetItemValue("$FilterFormulaCount")(0)
	If IsNumeric(varProfileCount) Then
		intProfileCount = CInt( varProfileCount )
	Else
		intProfileCount = 0
	End If

	If intProfileItemCount > intRulesCount Then
		intMax = intProfileItemCount
	Else
		intMax = intRulesCount
	End If

	ReDim arrConditions(intMax) As String
	ReDim arrActions(intMax) As String
	ReDim arrRuleNr(intMax) As String
	ReDim arrProfileEntries(intMax) As String

	For i = 1 To intMax
		arrRuleNr(i) = CStr(i)
		If i <= intRulesCount Then
			Set veRule = vecRules.Getnthentry(i)
			Set docRule = veRule.Document
			arrConditions(i) = Replace( FullTrim( Implode( docRule.Getitemvalue("ConditionList") , " " ) ), Chr$(13)&Chr$(10) , " ")
			arrActions(i) = Replace( FullTrim( Implode( docRule.Getitemvalue("ActionList") , " " ) ), Chr$(13)&Chr$(10) , " ")
		Else
			arrConditions(i) = VAL_EMPTY
			arrActions(i) = VAL_EMPTY
		End If
		If IsElement(lstFilterFormulas(CStr(i))) Then
			arrProfileEntries(i) = lstFilterFormulas(CStr(i))
		Else
			arrProfileEntries(i) = VAL_EMPTY
		End If
	Next


	Set docDialog = New NotesDocument( db )
	Call docDialog.Replaceitemvalue("RuleNrList", arrRuleNr)
	Call docDialog.Replaceitemvalue("AllConditionList", arrConditions)
	Call docDialog.Replaceitemvalue("AllActionList", arrActions)
	Call docDialog.Replaceitemvalue("AllProfileList", arrProfileEntries)	
	Call docDialog.Replaceitemvalue("ProfileCount", intProfileCount-1) '- Hier steht immer Anzahl Regeln + 1, also müssen wir 1 abziehen..
	Call ws.Dialogbox("DlgRuleCheck", True, True, True, True, True, False, "Regeln prüfen", docDialog, True, False, True)
EndSub:
	Exit Sub
ErrHandler:
	MessageBox "Fehler: " & Err & ","&Error &" in Zeile " & Erl
	Resume EndSub
End Sub