Das ganze Script, in Ordnung, ist aber ziemlich lang.
Aber hier ist es ... oh,oh...
[size=10pt]Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim collection As NotesDocumentCollection
Dim memo As NotesDocument
Dim datum As Variant
Dim heute As Variant
Dim morgen As Variant
Dim montag As Variant
Dim feiertag As Variant
Dim feiertag_1 As Variant
Dim person As Variant
Dim menu As Variant
Dim esser As Variant
Dim status As Variant
Dim var As Variant
Dim var1 As Variant
Dim var2 As Variant
Dim var3 As Variant
Dim var4 As Variant
Dim var5 As Variant
Dim total As Integer
Dim wert As Variant
Dim i1 As Integer
Dim i2 As Integer
Dim i3 As Integer
Dim i4 As Integer
Dim i5 As Integer
'Für die Wochentagsberechnung
Dim x As Variant
Dim wd As Integer
x = Today
wd% = Weekday(x)
'Für den Evaluate
Dim eval As String
Dim pruefung
Dim eval_1 As String
Dim pruefung_1
Dim i As Integer
Set db = session.CurrentDatabase
Set view = db.GetView("Bestellungen")
Set doc = view.GetFirstDocument
Set memo = New NotesDocument( db )
'RichText-Formatierungen
Dim rtitem As notesrichtextitem
Dim richStyle As NotesRichTextStyle
Set richStyle = session.CreateRichTextStyle
'Für das Mail
Dim pdoc As NotesDocument
Set pdoc = db.GetProfileDocument("profil")
an = pdoc.GetItemValue( "pMail" )
memo.Form = "Memo"
memo.SendTo = an
Set rtitem = memo.CreateRichTextItem("Body")
i1 = 0
i2 = 0
i3 = 0
i4 = 0
i5 = 0
'Fristberechnung
heute = Date 'heutige Datum
morgen = Date+1 'morgige Datum
montag = Date+3 'nächster Montag
'Feiertage aus dem Profildokument auslesen
feiertag = pdoc.GetItemValue( "Holidays" )
feiertag_1 = pdoc.GetItemValue( "Holidays_1" )
'Feiertage im Bundesland Hessen
Dim ftag As Variant
For i = Lbound(feiertag) To Ubound(feiertag)
ftag = Cdat(Strleft(feiertag(i)," =")) & ";" & ftag
Next
Dim array_ftag As Variant
array_ftag = Evaluate( |@Explode("| + ftag + |";";")| )
'Tagen an die unsere Firma geschlossen hat
For i = Lbound(feiertag_1) To Ubound(feiertag_1)
ftag_1 = Cdat(Strleft(feiertag_1(i)," =")) & ";" & ftag_1
Next
Dim array_ftag_1 As Variant
array_ftag_1 = Evaluate( |@Explode("| + ftag_1 + |";";")| )
While Not(doc Is Nothing)
datum = doc.GetItemValue("BestellungDatum")
person = doc.GetItemValue("BestellungName2")
menu = doc.GetItemValue("BestellungMenu")
esser = doc.GetItemValue("BestellungName")
status = doc.GetItemValue("Status")
Set doc = view.GetNextDocument(doc)
'Leerzeilen
leer = Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10)
'Nächste Zeile
leer1 = Chr$(13) & Chr$(10)
'Wenn heute Freitag(6) ist und Montag gleich das Bestelldatum ist oder morgen gleich das Bestelldatum ist und heute kein Freitag ist, dann
If Cstr(montag) = Cstr(datum(0)) And wd%=6_
Or morgen= Cstr(datum(0)) And wd%<>6_
Or feiertag(0).Contains( morgen )_
Or feiertag(0).Contains ( montag ) Then
Messagebox("Stimmt")
total = 0
Forall m In person
total = total + 1
End Forall
If (menu(0) = "Menue 1") Then
i1= i1 + total
If i1>0 Then
wert =subpruefung(doc,i,person,wert)
End If
var1=var1 + wert
End If
If (menu(0) = "Menue 2") Then
i2= i2 + total
If i2>0 Then
wert =subpruefung(doc,i,person,wert)
End If
var2= var2 + wert
End If
If (menu(0) = "Menue 3") Then
i3= i3 + total
If i3>0 Then
wert =subpruefung(doc,i,person,wert)
End If
var3=var3 + wert
End If
If (menu(0) = "Menue 4") Then
i4= i4 + total
If i4>0 Then
wert =subpruefung(doc,i,person,wert)
End If
var4= var4 + wert
End If
If (menu(0) = "Menue 5") Then
i5= i5 + total
If i5>0 Then
wert =subpruefung(doc,i,person,wert)
End If
var5= var5 + wert
End If
' End If *******muß wieder rein
End If
Wend
'Variable 1
eval = |@Begins("| + var1 + |";", ")|
pruefung = Evaluate(eval, doc)
If pruefung(0) = 1 Then
eval_1 = |@RightBack("| + var1 + |";2)|
pruefung_1 = Evaluate(eval_1, doc)
var1 = pruefung_1(0)
End If
If var1 <>"" Then
var1="Menue 1" & leer1 & var1 &leer
End If
'Variable 2
eval = |@Begins("| + var2 + |";", ")|
pruefung = Evaluate(eval, doc)
If pruefung(0) = 1 Then
eval_1 = |@RightBack("| + var2 + |";2)|
pruefung_1 = Evaluate(eval_1, doc)
var2 = pruefung_1(0)
End If
If var2 <>"" Then
var2 ="Menue 2" &leer1 & var2 &leer
End If
'Variable 3
eval = |@Begins("| + var3 + |";", ")|
pruefung = Evaluate(eval, doc)
If pruefung(0) = 1 Then
eval_1 = |@RightBack("| + var3 + |";2)|
pruefung_1 = Evaluate(eval_1, doc)
var3 = pruefung_1(0)
End If
If var3 <>"" Then
var3="Menue 3" &leer1 & var3 &leer
End If
'Variable 4
eval = |@Begins("| + var4 + |";", ")|
pruefung = Evaluate(eval, doc)
If pruefung(0) = 1 Then
eval_1 = |@RightBack("| + var4 + |";2)|
pruefung_1 = Evaluate(eval_1, doc)
var4 = pruefung_1(0)
End If
If var4 <>"" Then
var4="Menue 4" &leer1 & var4 &leer
End If
'Variable 5
eval = |@Begins("| + var5 + |";", ")|
pruefung = Evaluate(eval, doc)
If pruefung(0) = 1 Then
eval_1 = |@RightBack("| + var5 + |";2)|
pruefung_1 = Evaluate(eval_1, doc)
var5 = pruefung_1(0)
End If
If var5 <>"" Then
var5="Menue 5" &leer1 & var5 &leer
End If
var = var1 & var2 & var3 & var4 & var5
If var="" Then
var="Es liegen keine Essensbestellungen vor!"
End If
'Wenn der heutige Tag ein Freitag ist, dann nehme den nächsten Montag in die Mail mit auf
If wd%=6 Then
satz1 = "Essensplan für den " & Str$(montag)
Else
satz1 = "Essensplan für den " & Str$(morgen)
End If
satz2 = ( leer & var & leer )
satz2a = "Summen der bestellten Essen" & leer
satz3 = "Menue 1: "
satz4 = (Cstr(i1) & leer1)
satz5 = "Menue 2: "
satz6 = (Cstr(i2) & leer1)
satz7 = "Menue 3: "
satz8 = (Cstr(i3) & leer1)
satz9 = "Menue 4: "
satz10 = (Cstr(i4) & leer1)
satz11 = "Menue 5: "
satz12 = (Cstr(i5) & leer1)
memo.Subject = satz1
richStyle.Bold = True 'Eigenschaft "fett"setzen
richStyle.Underline = True
Call rtitem.AppendStyle(richStyle) 'Eigenschaft aktivieren
Call rtitem.appendtext(satz1)
richStyle.Bold = False 'Eigenschaft "fett" ausschalten
richStyle.Underline = False
Call rtitem.AppendStyle(richStyle)
Call rtitem.appendtext(satz2)
richStyle.Bold = True 'Eigenschaft "fett"setzen
richStyle.Underline = True
Call rtitem.AppendStyle(richStyle) 'Eigenschaft aktivieren
Call rtitem.appendtext(satz2a)
richStyle.Bold = False 'Eigenschaft "fett" ausschalten
richStyle.Underline = False
Call rtitem.AppendStyle(richStyle)
richStyle.Bold = True 'Eigenschaft "fett"setzen
Call rtitem.AppendStyle(richStyle) 'Eigenschaft aktivieren
Call rtitem.appendtext(satz3)
richStyle.Bold = False 'Eigenschaft "fett" ausschalten
Call rtitem.AppendStyle(richStyle)
Call rtitem.appendtext(satz4)
richStyle.Bold = True 'Eigenschaft "fett"setzen
Call rtitem.AppendStyle(richStyle) 'Eigenschaft aktivieren
Call rtitem.appendtext(satz5)
richStyle.Bold = False 'Eigenschaft "fett" ausschalten
Call rtitem.AppendStyle(richStyle)
Call rtitem.appendtext(satz6)
richStyle.Bold = True 'Eigenschaft "fett"setzen
Call rtitem.AppendStyle(richStyle) 'Eigenschaft aktivieren
Call rtitem.appendtext(satz7)
richStyle.Bold = False 'Eigenschaft "fett" ausschalten
Call rtitem.AppendStyle(richStyle)
Call rtitem.appendtext(satz8)
richStyle.Bold = True 'Eigenschaft "fett"setzen
Call rtitem.AppendStyle(richStyle) 'Eigenschaft aktivieren
Call rtitem.appendtext(satz9)
richStyle.Bold = False 'Eigenschaft "fett" ausschalten
Call rtitem.AppendStyle(richStyle)
Call rtitem.appendtext(satz10)
richStyle.Bold = True 'Eigenschaft "fett"setzen
Call rtitem.AppendStyle(richStyle) 'Eigenschaft aktivieren
Call rtitem.appendtext(satz11)
richStyle.Bold = False 'Eigenschaft "fett" ausschalten
Call rtitem.AppendStyle(richStyle)
Call rtitem.appendtext(satz12)
'wenn heute ein Samstag oder Sonntag ist dann
If wd% = 7 Or wd% =1 Then
'sende kein Mail
Else
Call memo.Send( False )
End If
Set collection = db.AllDocuments
Set doc = collection.GetFirstDocument()
While Not(doc Is Nothing)
datum = doc.GetItemValue("BestellungDatum")
status = doc.GetItemValue("Status")
If montag = Cstr(datum(0)) And Cstr(status(0))="0" And wd%=6 Or morgen = Cstr(datum(0)) And Cstr(status(0))="0" And wd%<>6 Then
doc.Status = "1"
Call doc.Save( False, True )
End If
Set doc = collection.GetNextDocument( doc)
Wend
Call view.Refresh
End Sub[/size]
.