searchFormula$ = {Form="Mitarbeiter" & GBDatum!="" & Inaktiv!="1"}
Set collection = db.Search( searchFormula$, Nothing, 0 )
anzahlF = collection.count
Set note = collection.GetFirstDocument
Do While Not (note Is Nothing)
Dim rtitem As NotesRichTextItem
Dim iDays As Integer
Dim aStartDateTime() As Variant
iDays = 0
Dim thisStartDateTime As NotesDateTime
Dim thisEndDateTime As NotesDateTime
Set thisStartDateTime = New NotesDateTime(note.GBDatum(0)& " 04:00:00")
Set thisEndDateTime = New NotesDateTime(thisStartDateTime.Lslocaltime)
Call thisEndDateTime.Adjustyear(3)
While thisStartDateTime.TimeDifference(thisEndDateTime) <= 0
Redim Preserve aStartDateTime(iDays)
aStartDateTime(iDays) = thisStartDateTime.LSLocalTime
iDays = iDays + 1
Call thisStartDateTime.Adjustyear(1)' Um einen Tage erhöhen
Wend
'Ende Liste aufbauen
Dim i As Integer
Dim EndTerminListe(3) As Variant
Dim StartEndTermin As New NotesDateTime(note.GBDatum(0)& " 04:00:00")
Dim StartEndTerminEnde As New NotesDateTime(note.GBDatum(0)& " 20:00:00")
Dim EndTermin As New NotesDateTime(note.GBDatum(0)& " 20:00:00")
For i = 0 To 3
EndTerminListe(i) = EndTermin.LSLocalTime
Call EndTermin.Adjustyear(1)
Next
Dim newtermin As NotesDocument
Set newtermin = maildb.CreateDocument
Dim BeginnTermin As NotesDateTime
Set BeginnTermin = New NotesDateTime( note.GBDatum(0)& " 04:00:00" )
Dim EndeTermin As NotesDateTime
Set EndeTermin = New NotesDateTime( note.GBDatum(0)& " 20:00:00" )
'Deklaration der Werte für NUR Datum und NUR Zeit Ende
Dim BeginnTerminDate As New NotesDateTime(BeginnTermin.DateOnly)
Call BeginnTerminDate.SetAnyTime
Set newtermin.StartDate = StartEndTermin 'BeginnTerminDate
Dim BeginnTerminTime As New NotesDateTime(BeginnTermin.TimeOnly)
Call BeginnTerminTime.SetAnyDate
Set newtermin.StartTime = StartEndTermin 'BeginnTerminTime
Set newtermin.AppendStartTime = BeginnTerminTime '08:00:00
'Deklaration der Werte für NUR Datum und NUR Zeit Ende
Dim EndeTerminDate As New NotesDateTime(EndeTermin.DateOnly)
Call EndeTerminDate.SetAnyTime
Set newtermin.EndDate = StartEndTerminEnde 'EndeTerminDate
Dim EndeTerminTime As New NotesDateTime(EndeTermin.TimeOnly)
Call EndeTerminTime.SetAnyDate
Set newtermin.EndTime = StartEndTerminEnde 'EndeTerminTime
Set newtermin.AppendEndTime = EndeTerminTime
newtermin.StartDateTime = aStartDateTime 'BeginnTermin.LSLocalTime
newtermin.CALENDARDATETIME = aStartDateTime 'BeginnTermin.LSLocalTime
newtermin.RepeatInstanceDates = aStartDateTime 'BeginnTermin.LSLocalTime
newtermin.OriginalStartDate = StartEndTermin.Lslocaltime
'newtermin.RepeatDates = aStartDateTime
newtermin.EndDateTime = EndTerminListe
newtermin.Form = "Appointment"
newtermin.AppointmentType = "1"
Dim ohneView(0 To 1) As String
ohneView(0) = "D"
ohneView(1) = "S"
newtermin.ExcludeFromView = ohneView
Call newtermin.ReplaceItemValue("$PublicAccess", "1")
Call newtermin.ReplaceItemValue("_ViewIcon", 63)
Call newtermin.ReplaceItemValue("$NoPurge", EndTerminListe(3))
Call newtermin.ReplaceItemValue("$TableSwitcher", "Description")
Call newtermin.ReplaceItemValue("dspNum", 4)
Call newtermin.ReplaceItemValue("IsBroadcast", "0")
Call newtermin.ReplaceItemValue("Logo", "StdNotesLtr25")
Call newtermin.ReplaceItemValue("OrgTable","A0")
Call newtermin.ReplaceItemValue("txtNum", CStr(4))
Call newtermin.ReplaceItemValue("UpdateSeq", 1)
Call newtermin.ReplaceItemValue("WebDateTimeInit", "1")
Call newtermin.ReplaceItemValue("xAMtg", "a Meeting")
Call newtermin.ReplaceItemValue("xAToDo", "a To Do")
Call newtermin.ReplaceItemValue("xMtg", "Meeting")
Call newtermin.ReplaceItemValue("xToDo", "To Do")
Call newtermin.ReplaceItemValue("$BusyPriority", "2")
Call newtermin.ReplaceItemValue("$BorderColor", "7F96A3")
Call newtermin.ReplaceItemValue("OrgConfidential", "1")
Call newtermin.ReplaceItemValue("$PublicAccess", "1")
Call newtermin.ReplaceItemValue("$BusyName", session.Username)
newtermin.CHAIR = session.UserName
newtermin.AltChair = session.UserName
newtermin.SchedulerSwitcher = "1"
newtermin.APPTUNID = newtermin.UniversalID
newtermin.Principal = session.UserName
newtermin.Repeats = "1"
newtermin.OrgRepeat = "1"
newtermin.BookFreeTime = "1"
newtermin.SequenceNum = 1
Dim watchitems(15) As Variant
watchitems(0) = "$S"
watchitems(1) = "$L"
watchitems(2) = "$B"
watchitems(3) = "$R"
watchitems(4) = "$E"
watchitems(5) = "$W"
watchitems(6) = "$O"
watchitems(7) = "$M"
watchitems(8) = "RequiredAttendees"
watchitems(9) = "INetRequiredNames"
watchitems(10) = "AltRequiredNames"
watchitems(11) = "StorageRequiredNames"
watchitems(12) = "OptionalAttendees"
watchitems(13) = "INetOptionalNames"
watchitems(14) = "AltOptionalNames"
watchitems(15) = "StorageOptionalNames"
'Call newtermin.ReplaceItemValue("$WatchedItems", watchitems)
Dim CSWISL(15) As Variant
CSWISL(0) = "$S:1"
CSWISL(1) = "$L:1"
CSWISL(2) = "$B:1"
CSWISL(3) = "$R:1"
CSWISL(4) = "$E:1"
CSWISL(5) = "$W:1"
CSWISL(6) = "$O:1"
CSWISL(7) = "$M:1"
CSWISL(8) = "RequiredAttendees:1"
CSWISL(9) = "INetRequiredNames:1"
CSWISL(10) = "AltRequiredNames:1"
CSWISL(11) = "StorageRequiredNames:1"
CSWISL(12) = "OptionalAttendees:1"
CSWISL(13) = "INetOptionalNames:1"
CSWISL(14) = "AltOptionalNames:1"
CSWISL(15) = "StorageOptionalNames:1"
'Call newtermin.ReplaceItemValue("$CSWISL", CSWISL)
Call newtermin.ReplaceItemValue("StartTimeZone", "Z=-1$DO=1$DL=3 -1 1 10 -1 1$ZX=96$ZN=W. Europe")
Call newtermin.ReplaceItemValue("EndTimeZone", "Z=-1$DO=1$DL=3 -1 1 10 -1 1$ZX=96$ZN=W. Europe")
newtermin.Subject = "Geburtstag: " & note.MA_Auswahl(0)
Set rtitem = New NotesRichTextItem( newtermin, "Notes" )
Set rtitem = New NotesRichTextItem( newtermin, "Body" )
Call rtitem.AppendText( "Dieser Geburtstag wurde am " & Now & " von " & user.Common & " aus der Datenbank UKS in den Kalender übernommen." )
Call newtermin.Save(True, False, True)
Set note = collection.GetNextDocument(note)
Erase aStartDateTime
Erase EndTerminListe
iDays = 0
Loop