Kalendereintrag mit Script als Erinnerung mit fester Zeitvorgabe

[snore]

Hallo,
ich bin neu im Forum - zwar schon einige Jahre als Notes-Admin tätig, konnte aber bisher meine Datenbanken soweit es ging' mit Formeln umsetzen! Es wird also Zeit die Script-Programmierung besser zu verstehen!

Die Aufgabe lautet:
Eine Schaltfläche in einer Datenbank, welche eine Erinnerung im persönlichen Kalender anlegt!
Den Code hierzu, konnte ich ja schon bei Euch stibitzen -> Vielen Dank an den Ersteller !!

So nun meine Probleme:
1) Ich möchte aus einem Feld im Dokument (reines Datumsfeld) den Wert ziehen und mit einer vorgegebenen Uhrzeit als Erinnerungseintrag verknüpfen! Wenn das Feld ein Datum/Zeit-Item ist, klappt dies bereits  !
2) Ich habe versucht den Code zu verstehen und ein paar REM's geschrieben ... vielleicht möchte sich jemand die Arbeit machen und noch was ergänzen
3) Warum springt der Code bei ..."Zusammenführung der ausgelesenen Daten   " (im Debugger) wieder nach oben ? Macht dies der Befehl .."Strtoken "


..so nun der Code:

Teil 1) bei Click.....
Sub Click(Source As Button)
   Dim CEntry As New CEntry()
   Dim ws As New NotesUIWorkspace
   Dim uiDoc As NotesUIDocument
   Set uiDoc = ws.CurrentDocument
   Call uidoc.Refresh
   
   
' Notes-HomeServer suchen
   Dim MailServer As Variant
   MailServer = Evaluate( "@MailDBName" )
   If MailServer(0) = "" Or MailServer(1) = "" Then
      Msgbox "Fehler: Ihr Notes-Server konnte nicht ermittelt werden! > Das Programm wird beendet"
      Goto p_ende      
   End If
   Print "Kalendereintrag erstellen -> Schritt 1 = Homeserver suchen erfolgreich ..... ="
   Print MailServer(0)
   Print MailServer(1)
   
' Notes Name aus aktueller Session suchen
   Dim session As New NotesSession
   Dim NotesNameUser As Variant   
   NotesNameUser = session.username
   If NotesNameUser = "" Then
      Msgbox "Sorry - Ihr Notes-Name konnte nicht ermittelt werden ! -> Das Programm wird beendet"
      Goto p_ende      
   End If
   Print "Kalendereintrag erstellen -> Schritt 2 = NotesName aus aktiver Session suchen.....="
   Print Cstr(NotesNameUser)
   
'  Vorgabewerte für die Klasse CEntry   
   
   Dim AktDok As notesDocument
   Dim WVDatum As notesdatetime
   
   Set AktDok = ws.CurrentDocument.Document
   Set WVDatum = AktDok.GetItemValueDateTimeArray("Wiedervorlage")(0)
   
   CEntry.AppType = "REMINDER"
   CEntry.User =  (NotesNameUser)
   CEntry.Subject = "Stellenveränderung für --> "  & uiDoc.FieldGetText("NameMitarbeiter")
   CEntry.Location =  uiDoc.FieldGetText("Ort")
   CEntry.Categories = ""
   Set CEntry.StartDT = WVDatum
   Msgbox "Wiedervorlagedatum " & WVDatum.localtime
   'Set CEntry.StartDT = New NotesDateTime("02.04.2013 21:30:00")
   Set CEntry.EndDT = New NotesDateTime("04.04.2013 21:40:00")
   
   Msgbox CEntry.CreateSingleEntry, 0 + 64,"Hinweis:"
   
p_ende:   
End Sub



Teil 2) .. Declaration


' Vorgabewerte
Const APP_FORM = "Appointment"
Const DD_SERVER = ""
Const SEPERATOR = "!!"

'Klasse =
Class CEntry
   
   Public Sub new()
   End Sub
   
'Datum und Zeit
   Private startdttm As NotesDateTime
   Private enddttm As NotesDateTime   
   Private moddttm As NotesDateTime
   Public Property Set StartDT As NotesdateTime
      Set startdttm = StartDT
   End Property
   Public Property Set EndDT As NotesdateTime
      Set enddttm = EndDT
   End Property
   
' Ort   
   Private strLocation As String
   Public Property Set Location As String   
      Me.strLocation = Location
      Print Cstr(("Kalendereintrag Ort ermitteln ...") & (Me.strLocation))      
   End Property   
   
'Kategorie im Kalenderdokument wenn sinnvoll ?!
   Private varCategories As Variant
   Public Property Set Categories As String   
      Me.varCategories = Split(Categories,";")
   End Property
   
' Eintragstyp   
   Private strType As String
   Public Property Set AppType As String   
      Me.strType = AppType
      Print Cstr(("Kalendereintrag Typ ermitteln ...") & (Me.strType))      
   End Property
   
' Anhand der Vorgabe unter Click .... wird das entsprechende Dokument erstellt!
   Public Property Get AppType As String   
      Select Case Ucase (Me.StrType)
      Case "APPOINTMENT", "TERMIN"
         AppType = "0"
      Case "ANNIVERSARY", "JAHRESTAG"
         AppType = "1"
      Case "EVENT", "GANZTAEGIGE VERANSTALTUNG"
         AppType = "2"
      Case "MEETING", "BESPRECHUNG"
         AppType = "3"
      Case "REMINDER", "ERINNERUNG"
         AppType = "4"
      Case Else
         AppType = "0"
      End Select
   End Property
   
'Betreff   
   Private strsubject As String
   Public Property Get subject As String
      subject = Me.strsubject
   End Property
   
   Public Property Set subject As String
      Me.strsubject = subject
      Print Cstr("Kalendereintrag Betreff ermitteln ...") & (Me.subject)       
   End Property   
   
   
'Maildatenbank finden
   
   Private struser As String
   Public Property Get user As String
      user = Me.struser
      Print Cstr(("Kalendereintrag User ermitteln ...") & (user))      
   End Property
   
   Public Property Set user As String
      Me.struser = user
      Print Cstr(("Kalendereintrag User ermitteln ...") & (Me.user))      
   End Property
   
   Public Property Get MailFile As String
      Dim s As New NotesSession
      
      If Me.struser = "" Then
         MailFIle = ""
      Else
         On Error 4731 Goto ERR_USER_NOT_FOUND
         Dim notesdir As NotesDirectory
         Set notesdir  = s.getDirectory(DD_SERVER)
         Dim homeserver As Variant
         homeserver =  notesdir.GetMailInfo (Me.struser, False, False)
         mailfile = Cstr(homeserver(0)) & SEPERATOR & Cstr(homeserver(3))   
         Print Cstr(("Kalendereintrag Homeserver ermitteln ...") & homeserver(0) & " / " &    homeserver(3))
         
EXIT_PROPERTY:
         Exit Property
         
ERR_USER_NOT_FOUND:
         mailfile = ""
         Resume EXIT_PROPERTY
      End If
      
   End Property
   
' Meldungen ausgeben
   Public Function CreateSingleEntry As String
      CreateSingleEntry = "Der Eintrag wurde erfolgreich als ""Erinnerung"" In Ihrem Kalender erstellt." & Chr(10) & Chr(10) _
      & "(" & Cstr(Me.subject) & " / " & Cstr(Me.startdttm.LSLocalTime)  &")" & Chr(10) & Chr(10) _
      &"Ein Service Ihrer IT-Orga....." 'kein Fehler
      
      If Trim(Me.strSubject) = "" Then
         CreateSingleEntry = "Der Eintrag konnte nicht gespeichert werden -> Betreff nicht gefunden !" & Chr(10) & Chr(10) _
         &"Bitte wenden Sie sich an die IT-Orga....." 'Betreff fehlt
         Exit Function
      End If
      
      If Me.startdttm.TimeDifference (Me.enddttm) > 0 Then
         CreateSingleEntry = "Der Eintrag konnte nicht gespeichert werden -> Datum fehlerhaft !" & Chr(10) & Chr(10) _
         &"Bitte wenden Sie sich an die IT-Orga....." 'Datum fehlerhaft
         Exit Function
      End If
      
      If Me.MailFile = "" Then
         CreateSingleEntry = "Der Eintrag konnte nicht gespeichert werden -> Kalender nicht gefunden !" & Chr(10) & Chr(10) _
         &"Bitte wenden Sie sich an die IT-Orga....." 'Kalenderzugriff nicht möglich
         Exit Function
         Sleep 1
      End If
      
'Zusammenführung der ausgelesenen Daten      
      Dim db As New NotesDatabase (Strtoken (Me.Mailfile,SEPERATOR,1), Strtoken (Me.Mailfile,SEPERATOR,2))
      
'Zugriff auf die Maildatenbank      
      If db.IsOpen () Then
         Dim session As New NotesSession
         Dim nam As NotesName
         Dim cEntry As New NotesDocument (db)
         Dim rtitem As Variant
         Dim itemIcon As NotesItem
         Dim item As NotesItem
         Dim ret As Variant
         
         Set nam = session.CreateName(Me.struser)      
         cEntry.Form = APP_FORM
         cEntry.~$Programmatically = "1"
         Set item = New NotesItem(cEntry, "From", nam.canonical)
         item.IsAuthors = True
         Set item = New NotesItem(cEntry, "Principal", nam.canonical)
         Set item = New NotesItem(cEntry, "$BusyName", nam.canonical)
         item.IsNames = True
         
'Icon anhand Kalendereintragstyp festlegen         
         cEntry.AppointmentType = Me.AppType
         Select Case Me.AppType
         Case 0
            Set itemIcon = New NotesItem(cEntry, "_ViewIcon", 160)
         Case 1
            Set itemIcon = New NotesItem(cEntry, "_ViewIcon", 63)   
         Case 2
            Set itemIcon = New NotesItem(cEntry, "_ViewIcon", 168)
         Case 3
            Set itemIcon = New NotesItem(cEntry, "_ViewIcon", 9)
         Case 4
            Set itemIcon = New NotesItem(cEntry, "_ViewIcon", 158)
         End Select
         itemIcon.IsSummary = True
         
         cEntry.~$BusyPriority = "1"
         cEntry.Subject = Me.subject
         
'Datum und Zeit setzen
         cEntry.StartDateTime = Me.startdttm.LSLocalTime
         cEntry.StartDate = Me.startdttm.LSLocalTime
         cEntry.StartTime = Me.startdttm.LSLocalTime
         cEntry.EndDateTime = Me.enddttm.LSLocalTime
         cEntry.EndDate = Me.enddttm.LSLocalTime
         cEntry.EndTime = Me.enddttm.LSLocalTime
         cEntry.calendarDateTime = Me.startdttm.LSLocalTime
         
' .. die weiteren Felder
         cEntry.~$NoPurge = Me.enddttm.LSLocalTime
         cEntry.~$PublicAccess = "1"
         cEntry.MailOptions=""
         cEntry.tmpWhichList = ""
         CEntry.~$Alarm            = 1
         CEntry.~$AlarmOffset            = -10
         CEntry.Alarms            = "1"
         CEntry.dispAlarms            = "1"
         CEntry.dispAlarmsRd            = "1"
         
         cEntry.ExcludeFromView = "D"
         cEntry.PutInFolder "($Alarms)", False
         
         Set item = New NotesItem(cEntry, "ExcludeFromView", "D")
         Call item.AppendToTextList ("S")
         cEntry.OrgTable = "C0"
         cEntry.Location = Me.strLocation
         Set item = New NotesItem(cEntry, "Categories", varCategories)         
         cEntry.Logo = "stdNotesLtr25"
         cEntry.OrgState = "x"
         cEntry.Repeats = ""
         cEntry.Resources = ""
         cEntry.SaveOptions = ""
         cEntry.SequenceNum = "1"
         cEntry.APPTUNID = cEntry.UniversalID
         Call cEntry.save(False, True)
         cEntry.PutInFolder "($Alarms)", False
         
      Else
         
         CreateSingleEntry = "Der Eintrag konnte nicht gespeichert werden -> Kalender nicht gefunden !" & Chr(10) & Chr(10) _
         &"Bitte wenden Sie sich an die IT-Orga....." 'Maildatenbank nicht möglich
         
      End If
   End Function
   
End Class

_____________



HERZLICHEN DANK  !!!!

[dnotes]

Ich bin mir nicht ganz sicher ob ich das Problem verstanden habe!
Woher kommt denn die vorgegebene Uhrzeit her??
Sei´s drum. Wenn Du also einen festen String als Zeit hinterlegen möchtest, dann geht das so:

Set CEntry.StartDT = New NotesDateTime(WVDatum.localtime + " 21:30:00")

[koehlerbv]

Sorry, aber der Code passt nicht zur angegebenen Aufgabenstellung. Mir ist auch ein Rätsel, wie Du den Code trotz syntaktischer Fehler überhaupt speichern konntest.

Du hast den Code nicht verstanden, sonst hättest Du zumindest gesehen, das es hier (und an vielen anderen Stellen) bessere Beispiele gibt.

Während Du LotusScript lernst (sehr löblich), solltest Du erstmal kleinere Brötchen backen. Dann können wir Dir auf dem Weg auch besser helfen.

Bernhard

[snore]

Hallo Bernhard,
..ja - hab's mir schon gedacht, dass ich gleich einen "kleinen Anpfiff" bekomme -> aber zurecht !

Sorry, ich hatte im Code was vergessen..bzw. gelöscht gehabt !
Wobei ich selbst zugebe, dass einiges im Code vermutlich doppelt vorhanden ist ... aber ich hoffe noch alles was da steht zu verstehen!
Danke
snore


....

   Dim AktDok As notesDocument
   Dim WVDatum As notesdatetime
   
   Set AktDok = ws.CurrentDocument.Document
   Set WVDatum = AktDok.GetItemValueDateTimeArray("Wiedervorlage")(0)
   
   CEntry.AppType = "REMINDER"
   CEntry.User =  (NotesNameUser)
   CEntry.Subject = "Stellenveränderung für --> "  & uiDoc.FieldGetText("NameMitarbeiter")
   CEntry.Location =  uiDoc.FieldGetText("Ort")
   CEntry.Categories = ""
   Set CEntry.StartDT = WVDatum
   Set CEntry.StartDT = New NotesDateTime(WVDatum.localtime + " 14:30:00")
   'Msgbox (WVDatum.localtime)
   Set CEntry.EndDT = New NotesDateTime(WVDatum.localtime + " 14:45:00")
   
   Msgbox CEntry.CreateSingleEntry, 0 + 64,"Hinweis:"
   
p_ende:   
End Sub


-> der Rest ist wie oben....

[snore]

Hallo,
ich hab' zu "meinem" Code noch folgende Frage ?

Der funktioniert zwar inzwischen 1A .... aber warum springt der Code (im Debugger) bei der Zeile...
"Dim db As New NotesDatabase (Strtoken (Me.Mailfile,SEPERATOR,1), Strtoken (Me.Mailfile,SEPERATOR,2)) "
3 x zurück

Hier nochmals der Code:


1) unter Click:

Sub Click(Source As Button)
   Dim CEntry As New CEntry()
   Dim ws As New NotesUIWorkspace
   Dim uiDoc As NotesUIDocument
   Set uiDoc = ws.CurrentDocument
   Call uidoc.Refresh
   
' Notes-HomeServer suchen
   Dim MailServer As Variant
   MailServer = Evaluate( "@MailDBName" )
   If MailServer(0) = "" Or MailServer(1) = "" Then
      Msgbox "Fehler: Ihr Notes-Server konnte nicht ermittelt werden! > Das Programm wird beendet"
      Goto p_ende      
   End If
   Print "Kalendereintrag erstellen -> Schritt 1 = Homeserver suchen erfolgreich ..... ="
   Print MailServer(0)
   Print MailServer(1)
   
' Notes Name aus aktueller Session suchen
   Dim session As New NotesSession
   Dim NotesNameUser As Variant   
   NotesNameUser = session.username
   If NotesNameUser = "" Then
      Msgbox "Sorry - Ihr Notes-Name konnte nicht ermittelt werden ! -> Das Programm wird beendet"
      Goto p_ende      
   End If
   Print "Kalendereintrag erstellen -> Schritt 2 = NotesName aus aktiver Session suchen.....="
   Print Cstr(NotesNameUser)
   
'  Vorgabewerte für den Kalendereintrag
   Dim AktDok As notesDocument
   Dim WVDatum As notesdatetime
   Set AktDok = ws.CurrentDocument.Document
   
   If uiDoc.FieldGetText("Wiedervorlage")= "" Then
      Msgbox "Hallo ?! - Sie haben kein Datum angegeben ! -> Das Programm wird beendet"
      Print "Kalendereintrag erstellen -> Schritt 3 = KEIN DATUM GEFUNDEN - Programm beendet !!"
      Goto p_ende      
   End If
   
   Print "Kalendereintrag erstellen -> Schritt 3 = Wiedervorlage Datum  gefunden!.....="
   Print Cstr(uiDoc.FieldGetText("Wiedervorlage"))
   
   Set WVDatum = AktDok.GetItemValueDateTimeArray("Wiedervorlage")(0)
   CEntry.AppType = "MEETING"
   CEntry.User =  (NotesNameUser)
   CEntry.Subject = "Stellenveränderung für --> "  & uiDoc.FieldGetText("NameMitarbeiter")
   CEntry.Location =  uiDoc.FieldGetText("Ort")
   CEntry.Categories = ""
   Set CEntry.StartDT = New NotesDateTime(WVDatum.localtime + " 09:00:00")
   Set CEntry.EndDT = New NotesDateTime(WVDatum.localtime + " 09:30:00")
   
   Msgbox CEntry.CreateSingleEntry, 0 + 64,"Hinweis:"
   
p_ende:   
End Sub


2) ..unter Declaration:

' Vorgabewerte
Const APP_FORM = "Appointment"
Const DD_SERVER = ""
Const SEPERATOR = "!!"

'Klasse =
Class CEntry
   
   Public Sub new()
   End Sub
   
'Datum und Zeit
   Private startdttm As NotesDateTime
   Private enddttm As NotesDateTime   
   Private moddttm As NotesDateTime
   Public Property Set StartDT As NotesdateTime
      Set startdttm = StartDT
   End Property
   Public Property Set EndDT As NotesdateTime
      Set enddttm = EndDT
   End Property
   
' Ort   
   Private strLocation As String
   Public Property Set Location As String   
      Me.strLocation = Location
      Print Cstr(("Kalendereintrag Ort ermitteln ...") & (Me.strLocation))      
   End Property   
   
'Kategorie im Kalenderdokument wenn sinnvoll ?!
   Private varCategories As Variant
   Public Property Set Categories As String   
      Me.varCategories = Split(Categories,";")
   End Property
   
' Eintragstyp   
   Private strType As String
   Public Property Set AppType As String   
      Me.strType = AppType
      Print Cstr(("Kalendereintrag Typ ermitteln ...") & (Me.strType))      
   End Property
   
' Anhand der Vorgabe unter Click .... wird das entsprechende Dokument erstellt!
   Public Property Get AppType As String   
      Select Case Ucase (Me.StrType)
      Case "APPOINTMENT", "TERMIN"
         AppType = "0"
      Case "ANNIVERSARY", "JAHRESTAG"
         AppType = "1"
      Case "EVENT", "GANZTAEGIGE VERANSTALTUNG"
         AppType = "2"
      Case "MEETING", "BESPRECHUNG"
         AppType = "3"
      Case "REMINDER", "ERINNERUNG"
         AppType = "4"
      Case Else
         AppType = "0"
      End Select
   End Property
   
'Betreff   
   Private strsubject As String
   Public Property Get subject As String
      subject = Me.strsubject
   End Property
   
   Public Property Set subject As String
      Me.strsubject = subject
      Print Cstr("Kalendereintrag Betreff ermitteln ...") & (Me.subject)       
   End Property   
   
   
'Maildatenbank finden
   
   Private struser As String
   Public Property Get user As String
      user = Me.struser
      Print Cstr(("Kalendereintrag User ermitteln ...") & (user))      
   End Property
   
   Public Property Set user As String
      Me.struser = user
      Print Cstr(("Kalendereintrag User ermitteln ...") & (Me.user))      
   End Property
   
   Public Property Get MailFile As String
      Dim s As New NotesSession
      
      If Me.struser = "" Then
         MailFIle = ""
      Else
         On Error 4731 Goto ERR_USER_NOT_FOUND
         Dim notesdir As NotesDirectory
         Set notesdir  = s.getDirectory(DD_SERVER)
         Dim homeserver As Variant
         homeserver =  notesdir.GetMailInfo (Me.struser, False, False)
         mailfile = Cstr(homeserver(0)) & SEPERATOR & Cstr(homeserver(3))   
         Print Cstr(("Kalendereintrag Homeserver ermitteln ...") & homeserver(0) & " / " &    homeserver(3))
         
EXIT_PROPERTY:
         Exit Property
         
ERR_USER_NOT_FOUND:
         mailfile = ""
         Resume EXIT_PROPERTY
      End If
      
   End Property
   
' Meldungen ausgeben
   Public Function CreateSingleEntry As String
      
      If Cstr(Me.StrType) = "REMINDER" Then
         CreateSingleEntry = "Der Eintrag wurde erfolgreich als Erinnerung" & Chr(10) & "in Ihrem Kalender erstellt." & Chr(10) & Chr(10) _
         & "(" & Cstr(Me.subject) & " / " & Chr(10)  & Cstr(Me.startdttm.LSLocalTime)  &")" & Chr(10) & Chr(10) _
         &"Ein Service Ihrer IT-Orga....." 'kein Fehler
      End If
      
      If Cstr(Me.StrType) = "EVENT" Then
         CreateSingleEntry = "Der Eintrag wurde erfolgreich als Ganztägige Veranstaltung" & Chr(10) & "in Ihrem Kalender erstellt." & Chr(10) & Chr(10) _
         & "(" & Cstr(Me.subject)  &")" & Chr(10) & Chr(10) _
         &"Ein Service Ihrer IT-Orga....." 'kein Fehler
      End If
      
      If Cstr(Me.StrType) = "APPOINTMENT" Then
         CreateSingleEntry = "Der Eintrag wurde erfolgreich als Termin" & Chr(10) & "in Ihrem Kalender erstellt." & Chr(10) & Chr(10) _
         & "(" & Cstr(Me.subject) & " / " & Chr(10) & Cstr(Me.startdttm.LSLocalTime)  & " bis " & Cstr(Me.enddttm.LSLocalTime) &")" & Chr(10) & Chr(10) _
         &"Ein Service Ihrer IT-Orga....." 'kein Fehler
      End If
      
      If Cstr(Me.StrType) = "ANNIVERSARY" Then
         CreateSingleEntry = "Der Eintrag wurde erfolgreich als Jahrestag" & Chr(10) & "in Ihrem Kalender erstellt." & Chr(10) & Chr(10) _
         & "(" & Cstr(Me.subject) & " / " & Chr(10) & Cstr(Me.startdttm.LSLocalTime) & Chr(10) & Chr(10) _
         &"Ein Service Ihrer IT-Orga....." 'kein Fehler
      End If
      
      If Cstr(Me.StrType) = "MEETING" Then
         CreateSingleEntry = "Der Eintrag wurde erfolgreich als Besprechungstermin" & Chr(10) & "in Ihrem Kalender erstellt." & Chr(10) & Chr(10) _
         & "(" & Cstr(Me.subject) & " / " & Chr(10) & Cstr(Me.startdttm.LSLocalTime)  & " bis " & Cstr(Me.enddttm.LSLocalTime) &")" & Chr(10) & Chr(10) _
         &"Ein Service Ihrer IT-Orga....." 'kein Fehler
      End If
      
      If Trim(Me.strSubject) = "" Then
         CreateSingleEntry = "Der Eintrag konnte nicht gespeichert werden -> Betreff nicht gefunden !" & Chr(10) & Chr(10) _
         &"Bitte wenden Sie sich an die IT-Orga....." 'Betreff fehlt
         Exit Function
      End If
      
      If Me.startdttm.TimeDifference (Me.enddttm) > 0 Then
         CreateSingleEntry = "Der Eintrag konnte nicht gespeichert werden -> Datum fehlerhaft !" & Chr(10) & Chr(10) _
         &"Bitte wenden Sie sich an die IT-Orga....." 'Datum fehlerhaft
         Exit Function
      End If
      
      If Me.MailFile = "" Then
         CreateSingleEntry = "Der Eintrag konnte nicht gespeichert werden -> Kalender nicht gefunden !" & Chr(10) & Chr(10) _
         &"Bitte wenden Sie sich an die IT-Orga....." 'Kalenderzugriff nicht möglich
         Exit Function
         Sleep 1
      End If
      
'Zusammenführung der ausgelesenen Daten      
      Dim db As New NotesDatabase (Strtoken (Me.Mailfile,SEPERATOR,1), Strtoken (Me.Mailfile,SEPERATOR,2))
      
'Zugriff auf die Maildatenbank      
      If db.IsOpen () Then
         Dim session As New NotesSession
         Dim nam As NotesName
         Dim cEntry As New NotesDocument (db)
         Dim rtitem As Variant
         Dim itemIcon As NotesItem
         Dim item As NotesItem
         Dim ret As Variant
         
         Set nam = session.CreateName(Me.struser)      
         cEntry.Form = APP_FORM
         cEntry.~$Programmatically = "1"
         Set item = New NotesItem(cEntry, "From", nam.canonical)
         item.IsAuthors = True
         Set item = New NotesItem(cEntry, "Principal", nam.canonical)
         Set item = New NotesItem(cEntry, "$BusyName", nam.canonical)
         item.IsNames = True
         
'Icon anhand Kalendereintragstyp festlegen         
         cEntry.AppointmentType = Me.AppType
         Select Case Me.AppType
         Case 0
            Set itemIcon = New NotesItem(cEntry, "_ViewIcon", 160)
         Case 1
            Set itemIcon = New NotesItem(cEntry, "_ViewIcon", 63)   
         Case 2
            Set itemIcon = New NotesItem(cEntry, "_ViewIcon", 168)
         Case 3
            Set itemIcon = New NotesItem(cEntry, "_ViewIcon", 9)
         Case 4
            Set itemIcon = New NotesItem(cEntry, "_ViewIcon", 158)
         End Select
         itemIcon.IsSummary = True
         
         cEntry.~$BusyPriority = "1"
         cEntry.Subject = Me.subject
         
'Datum und Zeit setzen
         cEntry.StartDateTime = Me.startdttm.LSLocalTime
         cEntry.StartDate = Me.startdttm.LSLocalTime
         cEntry.StartTime = Me.startdttm.LSLocalTime
         cEntry.EndDateTime = Me.enddttm.LSLocalTime
         cEntry.EndDate = Me.enddttm.LSLocalTime
         cEntry.EndTime = Me.enddttm.LSLocalTime
         cEntry.calendarDateTime = Me.startdttm.LSLocalTime
         
' .. die weiteren Felder wegen Kalenderalarm und richtige Ansichten/Folder !
         cEntry.~$NoPurge = Me.enddttm.LSLocalTime
         cEntry.~$PublicAccess = "1"
         cEntry.MailOptions=""
         cEntry.tmpWhichList = ""
         CEntry.~$Alarm            = 1
         CEntry.~$AlarmOffset            = -10
         CEntry.Alarms            = "1"
         CEntry.dispAlarms            = "1"
         CEntry.dispAlarmsRd            = "1"
         
         cEntry.ExcludeFromView = "D"
         cEntry.PutInFolder "($Alarms)", False
         
         Set item = New NotesItem(cEntry, "ExcludeFromView", "D")
         Call item.AppendToTextList ("S")
         cEntry.OrgTable = "C0"
         cEntry.Location = Me.strLocation
         Set item = New NotesItem(cEntry, "Categories", varCategories)         
         cEntry.Logo = "stdNotesLtr25"
         cEntry.OrgState = "x"
         cEntry.Repeats = ""
         cEntry.Resources = ""
         cEntry.SaveOptions = ""
         cEntry.SequenceNum = "1"
         cEntry.APPTUNID = cEntry.UniversalID
         Call cEntry.save(False, True)
         cEntry.PutInFolder "($Alarms)", False
         
      Else
         
         CreateSingleEntry = "Der Eintrag konnte nicht gespeichert werden -> Kalender nicht gefunden !" & Chr(10) & Chr(10) _
         &"Bitte wenden Sie sich an die IT-Orga....." 'Zugriff auf Maildatenbank nicht möglich
         
      End If
   End Function
   
End Class



3) DANKE !
snore