Das hier habe ich mal geschrieben (das prüft die Regeln im CalendarProfile gleich noch gegen die tatsächlich vorhandenen Regeln)
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
Alles anzeigen
Dazu ne kleine Dialogmaske mit den entsprechenden Feldern... Aber natürlich kannst Du Dir die Arrays auch einfach in ne Mail schreiben..
