| 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 |
| |
| ' |
| 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 |
