Hallo zusammen,
ich hab jetzt schon sehr viele Foren durchforstet, hab mir auch den C&S-Guide durchgeschaut, aber irgendwie funkt der folgende Code nicht.
Das Problem ist, dass mir zwar der Eintrag erstellt wird, aber in der FreeTimeSearch dann der Zeitraum für den ganzen Tag nicht als "Busy"
dargestellt wird.
Wenn ich allerdings den Eintrag dann öffne und speichere, wird die FreeTime korrekt angezeigt. Hat einer eine Idee, woran´s liegen kann ??
Was mir aufgefallen ist, war, dass das Feld "$BusyName" in den Feld-Flags "SUMMARY" eingetragen hat, nach dem neuerlichen Speichern aber
als SUMMARY NAMES beinhaltet ...
Hier noch der Code - bin als Admin über jede Hilfe dankbar 
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim collection As NotesDocumentCollection
Dim doc As NotesDocument
Dim DueDateStr As String
Dim DueDate As NotesDateTime
Dim EndDt As NotesDateTime
Dim BeginTime As NotesDateTime
Dim EndTime As NotesDateTime
Dim Dur As Integer
Dim Subject As String
Dim PopUp As String
Dim Requestor As String
Dim i As Integer
Dim ToMine As String
Dim EvtDueDate, EvtEndDate As Variant
Set db = session.CurrentDatabase
Set collection = db.UnprocessedDocuments
For i = 1 To collection.Count
Set doc = collection.GetNthDocument( i )
If doc.Form(0) = "Reiseantrag" Then
Subject = "Reise von " & doc.Abfahrt1(0) & " bis " & doc.Rückkehr1(0)
Else
Subject = "Urlaub von " & doc.Datum1_vom(0) & " bis " & doc.Datum1_bis(0)
End If
Requestor = doc.RequesterName(0)
EvtDueDate = doc.Datum1_vom(0)
EvtEndDate = doc.Datum1_bis(0)
Dur = (EvtEndDate - EvtDueDate) + 1
Popup = doc.Urlaubsart(0) & " " & doc.WLT_d(0)
Set DueDate = New NotesDateTime(EvtDueDate)
Set EndDt = New NotesDateTime(EvtEndDate)
ToMine = MessageBox("Möchten Sie den Eintrag in Ihren Kalender übernehmen ?", 36,"Übernahme Eintrag")
If ToMine = 6 Then
Call CreateReminder(DueDate, EndDt, Dur, PopUp, Subject, Requestor, session )
End If
Next
End Sub
Sub createReminder( dateTime As NotesDateTime, EndDt As NotesDateTime, dur As Integer, popUpStr As String, subjectStr As String, Requestor As String, sess As Variant )
Dim userMailDb As New NotesDatabase( "", "" )
Call userMailDb.OpenMail
'If Person adding appointment to their calendar is the person with the appointment, appointment type = event, otherwise it's a reminder.
'get current user name
Dim UsrName As String
UsrName = sess.username
Dim AppType,ATStr, Adjust As String
Dim ViewIco, n As Integer
AppType = "2" ' AppointmentType 2 = FullDayEvent
ATStr = "Appointment"
ViewIco = 9
' loops to create reminder docs for each day, in cases where person with appt is not the person adding value to their calendar
For n = 0 To dur - 1
Dim reminderDoc As New NotesDocument( userMailDb )
' This routine sets a field called TimeRange in the appointment. I'm not sure of the implication of this field - it doesn't appear to be used in reminders.
If n = 0 Then Adjust = 0 Else adjust = 1
Call datetime.AdjustDay(Adjust,True)
Dim NTRange As NotesDateRange
Set NTRange = sess.CreateDateRange()
Set NTRange.StartDateTime = dateTime
Set NTRange.EndDateTime = EndDt
Set reminderdoc.TimeRange = NTRange
Print "Adding: " & Requestor & " " & ATStr & " for: " & dateTime.LocalTime
With reminderDoc
.ReplaceItemValue "$BusyPriority", "1"
.ReplaceItemValue "$BusyName", UsrName
.ReplaceItemValue "$altPrincipal", UsrName
.ReplaceItemValue "_viewIcon", ViewIco
.Form = "Appointment"
.Principal = UsrName
.From = UsrName
.Chair = UsrName
.AltChair = UsrName
.AltFrom = UsrName
.BookFreeTime = ""
.Subject = subjectStr
.Alarms = "0" '0 turns off alarm, 1 turns it on
.Duration = dur
.ExcludeFromView = "D" ' keeps items out of the draft view.
.CalendarDateTime = dateTime.lsLocalTime
.StartDate = dateTime.lsLocaltime
.StartTime = dateTime.lsLocaltime
.StartDateTime = dateTime.lsLocaltime
.EndDate = EndDt.lsLocaltime
.EndTime = EndDt.lsLocaltime
.EndDateTime = EndDt.lsLocaltime
.PostedDate = dateTime.lsLocaltime
.AppointmentType = AppType
.ComputeWithForm True, False
.Save True, False
' .PutInFolder( "$Alarms" )
End With
Next
MessageBox "Sollten Sie den Eintrag im Urlaubskalender löschen, müssen Sie diesen manuell aus Ihrem persönlichen Kalender entfernen"
Exit Sub
'*********************************************************************************************************************************************************************************************************
End Sub
Danke, Rainer