habe hier mal eine kleine Klasse geschrieben, die einen Termin im Kalender eines Notes Users erzeugt. Wie man sieht, kommt man mit nur zwei feldern NICHT aus ( Das ist das, was Bernhard wissen wollte ) . Im Frontend werden die benötigten Felder ja beim Speichern entweder durch Vorgabewerte oder durch Code in den masken events gesetzt. Im Backend muss man da schon ein bisschen mehr machen.
Const APP_FORM = "Appointment"
Const DD_SERVER = "Serv01"
Const SEPERATOR = "!!"
Class CEntry
Public Sub new()
End Sub
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
Private strLocation As String
Public Property Set Location As String
Me.strLocation = Location
End Property
Private varCategories As Variant
Public Property Set Categories As String
Me.varCategories = Split(Categories,";")
End Property
Private strType As String
Public Property Set AppType As String
Me.strType = AppType
End Property
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
Private strsubject As String
Public Property Get subject As String
subject = Me.strsubject
End Property
Public Property Set subject As String
Me.strsubject = subject
End Property
Private struser As String
Public Property Get user As String
user = Me.struser
End Property
Public Property Set user As String
Me.struser = user
End Property
Public Property Get MailFile As String
Dim s As New NotesSession
If Me.struser = "" Then
MailFIle = ""
Else ' Notes Version is < 8.x
If s.NotesBuildVersion < 307 Then
Dim db As New NotesDatabase ( DD_SERVER, "names.nsf" )
Dim v As NotesView
Dim doc As NotesDocument
If db.IsOpen() Then
Set v = db.GetView("($Users)")
If Not ( v Is Nothing ) Then
Set doc = v.GetDocumentByKey (Me.user)
If Not ( doc Is Nothing ) Then
MailFIle = doc.MailServer(0) & SEPERATOR & doc.MailFile(0)
Else
Goto ERR_USER_NOT_FOUND
End If
Else
Goto ERR_USER_NOT_FOUND
End If
Else
Goto ERR_USER_NOT_FOUND
End If
Else ' we are running at least Notes Version 8
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))
End If
EXIT_PROPERTY:
Exit Property
ERR_USER_NOT_FOUND:
mailfile = ""
Resume EXIT_PROPERTY
End If
End Property
Public Function CreateSingleEntry As Integer
CreateSingleEntry = 0 ' no error
If Trim(Me.strSubject) = "" Then
CreateSingleEntry = 3 ' Subject missing
Exit Function
End If
If Me.startdttm.TimeDifference (Me.enddttm) > 0 Then
CreateSingleEntry = 4 ' EndDT before StartDT
Exit Function
End If
If Me.MailFile = "" Then
CreateSingleEntry = 1 'No MailFile or User not found
Exit Function
End If
Dim db As New NotesDatabase ( _
Strtoken (Me.Mailfile,SEPERATOR,1), Strtoken (Me.Mailfile,SEPERATOR,2))
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)
'----------- Set User and Description ----------------
cEntry.Form = APP_FORM
cEntry.~$Programmatically = "1"
'cEntry.tmpOwnerHW = "0"
Set item = New NotesItem(cEntry, "From", nam.canonical)
item.IsAuthors = True
Set item = New NotesItem(cEntry, "Principal", nam.canonical)
'Set item = New NotesItem(cEntry, "Chair", nam.canonical)
Set item = New NotesItem(cEntry, "$BusyName", nam.canonical)
item.IsNames = True
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
'----------- Set Date and Times ----------------
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
'----------- Set Other Fields ----------------
cEntry.~$NoPurge = Me.enddttm.LSLocalTime
cEntry.~$PublicAccess = "1"
cEntry.MailOptions=""
cEntry.tmpWhichList = ""
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.Categories = "Test"
cEntry.Logo = "stdNotesLtr0"
cEntry.OrgState = "x"
cEntry.Repeats = ""
cEntry.Resources = ""
cEntry.SaveOptions = ""
cEntry.SequenceNum = "1"
cEntry.APPTUNID = cEntry.UniversalID
'//Call cEntry.ComputeWithForm (False,True)
Call cEntry.save(False, True)
Else
CreateSingleEntry = 2 'MalFile cannot be opened
End If
End Function
End Class
Sub Click(Source As Button)
Dim CEntry As New CEntry()
CEntry.AppType = "Appointment"
CEntry.User = "Beta User/Singultus"
CEntry.Subject = "Hier kommt ein Eintrag"
CEntry.Location = "Mettmann"
CEntry.Categories = "Test;test1;test2"
Set CEntry.StartDT = New NotesDateTime("11.07.2008 13:00:00")
Set CEntry.EndDT = New NotesDateTime("11.07.2008 14:00:00")
Msgbox CEntry.CreateSingleEntry
End Sub
Ach ja, wie man sieht wird der Eintrag im Backend erzeugt ...
