0 pts.
 Calendar posting
I have developed an application that is a vacation approval workflow. It uses a group calendar once the vacation is approved, it is posted here on the calendar. How do I post approved date(s) to a user's personal calendar using LotusScript?

Software/Hardware used:
ASKED: November 21, 2006  1:39 PM
UPDATED: October 28, 2010  8:23 AM

Answer Wiki:
This script is from Notes.net posted by Ernie Mercer I have not tried it, but let us know if it works. Option Public Option Declare %REM AUTHOR: Ernie Mercer (based on original code by Ike Eagle which only handled anniversary calendary entries) CREATED: 7/27/2005 This library can be used to create personal calendar entries in a user's mailfile, including repeat entries. For our purposes we needed this to take calendar related documents such as vacation requests and team room calendar entries and create appropriate documents in the user's personal mail file calendar. Given the right parameters it can create most any type of calendar entry: appointment, event, reminder, anniversary, or (very limited) even a meeting (but because of the complexity involved in sending notifications to invitees and rooms/ resources such notifications are not supported - users should then be advised to manually create such meeting invitations). It can also be used to link to a source document and/or copy over rich text from a source document. The following parameters are required for proper processing of an entry: dbCal As notesdatabase = the database to create the calendar entry in sUser As String = the full heirarchical name of the person to create the calendar for sType As String = the type of calendar entry ("Appointment", "Reminder", "Even", "Anniversary", "Meeting") sSubject As String = the title/subject of the calendar entry vCalStartDates As Variant = a list array containing the start date of the entry (or start dates if a repeat entry) vCalEndDates As Variant = a list array containing the end date of the entry (or end dates if a repeat entry) RepeatFlags As Variant = A five element array containing necessary details for repeat entries 'RepeatFlags(0) = RepeatForUnit 'RepeatFlags(1) = RepeatHow 'RepeatFlags(2) = RepeatInterval 'RepeatFlags(3) = RepeatUnit 'RepeatFlags(4) = RepeatWeekends Comment As String = the comment to be entered in the Body of the calendar entry docLink As NotesDocument = a document to be linked into the Body of the calendary entry IncludeLink As Boolean = True/False - specifies whether or not to include a doc link to the docLink document RTFField As String = an rich text field from the linked doc to be copy into the Body of the calendar entry Location As String = the location of the appointment/event %END REM Function createCalEntry(dbCal As notesdatabase, _ sUser As String, sType As String, sSubject As String, vCalStartDates As Variant, _ vCalEndDates As Variant, RepeatFlags As Variant, Comment As String, _ docLink As NotesDocument, IncludeLink As Boolean, RTFField As String,_ Location As String) As Boolean Dim wksp As New notesuiworkspace Dim docNew As NotesDocument Dim docResp As notesdocument Dim iAlarm As Integer Dim docNotice As NotesDocument Dim EditEntry As Boolean EditEntry = True createCalEntry = False 'iRepeat: Number of Entries 'iAlarm: 6 if you want Alarm-Function Set docNew = dbCal.CreateDocument Call createCommonFields(docNew, sUser, sType, sSubject, _ vCalStartDates, vCalEndDates, Comment, docLink, IncludeLink, RTFField, Location) '***Create Repeat-Documents*** If Ubound(vCalStartDates) > 1 Then Call createRepeatFields(docNew, vCalStartDates, vCalEndDates, RepeatFlags) docNew.ApptUNID = docNew.UniversalID %REM If EditEntry = True Then Call wksp.EditDocument(True,docNew) createCalEntry = True Exit Function End If %END REM Call docNew.ComputeWithForm(True,False) Call docNew.Save(True,False) 'Create RESPONSE Set docResp = dbCal.CreateDocument Call docResp.MakeResponse( docNew) Call createCommonFields(docResp, sUser, sType, sSubject, _ vCalStartDates, vCalEndDates, Comment, docLink, IncludeLink, _ RTFField, Location) Call createRepeatFields(docResp, vCalStartDates, vCalEndDates, RepeatFlags) docResp.ReplaceItemValue "$CSFlags", "i" docResp.~$RefOptions = "1" docResp.ApptUNID = docNew.UniversalID docResp.tmpOwnerHW = "0" docResp.WebDateTimeInit = "1" docResp.OrgState ="x" docResp.CalendarDateTime = vCalStartDates docResp.OriginalStartDate = vCalStartDates(0) docResp.OriginalModTime = vCalStartDates(0) 'Remove Items Call docResp.RemoveItem( "RepeatDates" ) Call docResp.RemoveItem( "RepeatEndDates" ) Call docResp.RemoveItem( "RepeatFor" ) Call docResp.RemoveItem( "RepeatForUnit" ) Call docResp.RemoveItem( "RepeatHow" ) Call docResp.RemoveItem( "RepeatInterval" ) Call docResp.RemoveItem( "RepeatStartDate" ) Call docResp.RemoveItem( "RepeatUnit" ) Call docResp.RemoveItem( "RepeatWeekends" ) docResp.AdlinkCustomCalendarEntry = "Yes" Call docResp.ComputeWithForm(True,False) Call docResp.Save(True,False) If iAlarm = 6 Then Call docResp.PutInFolder( "$Alarms" ) End If 'send any required notifications %REM (but because of the complexity involved in sending notifications to invitees and rooms/ resources such notifications are not supported - users should then be advised to manually create such meeting invitations). If Isarray(invitees) Then Set docNotice = dbCal.CreateDocument() Call docResp.CopyAllItems(docNotice) With docNotice .RemoveItem("$Ref") .RemoveItem("CalendarDateTime") .RemoveItem("RepeatInstanceDates") .EndDateTime = vCalEndDates(0) .Form = "Notice" .PostedDate = Now .RepeatDates = vCalStartDates .RepeatEndDates = vCalEndDates .RepeatStartDate = vCalStartDates(0) .SendTo = invitees .StartDateTime = vCalStartDates(0) .~_ViewIcon = 133 Call docNotice.ComputeWithForm(True,False) Call .Send(False) End With Set docNotice = Nothing With docResp .PostedDate = Now Call .Save(True,False) End With End If %END REM Else 'No Repeat docNew.CalendarDateTime = vCalStartDates docNew.AdlinkCustomCalendarEntry = "Yes" Call docNew.ComputeWithForm(True,False) Call docNew.Save(True,False) If iAlarm = 6 Then Call docNew.PutInFolder( "$Alarms" ) End If 'send any required notifications %REM (but because of the complexity involved in sending notifications to invitees and rooms/ resources such notifications are not supported - users should be advised to manually create such meeting invitations). If Isarray(invitees) Then Set docNotice = dbCal.CreateDocument() Call docNew.CopyAllItems(docNotice) With docNotice .RemoveItem("$Ref") .RemoveItem("CalendarDateTime") .RemoveItem("RepeatInstanceDates") .EndDateTime = vCalEndDates(0) .Form = "Notice" .PostedDate = Now .RepeatDates = vCalStartDates .RepeatEndDates = vCalEndDates .RepeatStartDate = vCalStartDates(0) .SendTo = invitees .StartDateTime = vCalStartDates(0) .~_ViewIcon = 133 Call docNotice.ComputeWithForm(True,False) Call .Send(False) End With Set docNotice = Nothing With docNew .PostedDate = Now Call .Save(True,False) End With End If %END REM End If ' If Isarray(invitees) Then ' Messagebox "The entry has been saved to your calendar and notifications " &_ ' "have been sent the invitees.", 0, "Calendar Updated Successfully" ' Else Messagebox "The entry has been saved to your calendar.",_ 0, "Calendar Updated Successfully" ' End If createCalEntry = True End Function Sub createCommonFields(docNew As NotesDocument, sUser As String, _ sType As String, sSubject As String, vCalStartDates As Variant, vCalEndDates As Variant, _ Comment As String, docLink As NotesDocument, IncludeLink As Boolean, _ RTFField As String, Location As String) Dim sExclude(1) As String Dim iAlarm As Integer sExclude(0) = "D" sExclude(1) = "S" With docNew .~$BusyPriority = "1" .~$NoPurge = vCalStartDates(0) .~$PublicAccess = "1" .Form = "Appointment" .From = sUser .Principal = sUser Select Case sType Case "Appointment" .AppointmentType = "0" .OrgTable="C0" .~_ViewIcon = 160 Case "Anniversary" .AppointmentType = "1" .OrgTable="A0" .~_ViewIcon = 63 Case "Event" .AppointmentType = "2" .OrgTable="P0" .~_ViewIcon = 9 Case "Meeting" .AppointmentType = "3" .OrgTable="C0" .~_ViewIcon = 158 '.RequiredAttendees = Invitees Case "Reminder" .AppointmentType = "4" .OrgTable="C0" .~_ViewIcon = 10 End Select .Subject = sSubject .Categories="" .Chair = sUser .StartDateTime =vCalStartDates .StartDate = vCalStartDates(0) .StartTime = vCalStartDates(0) .EndDateTime = vCalEndDates .EndDate = vCalEndDates(0) .EndTime = vCalEndDates(0) .BookFreeTime="" .Logo="StdNotesLtr15" .ExcludeFromView= sExclude .SequenceNum=1 .Alarms= "" 'Evt. Alarm auch noch einbauen. .AltChair = sUser .Location = Location '.Resources = Resources '.OrgConfidential = '.UpdateSeq = '.Duration=1 'If Isarray(invitees) Then ' .RequiredAttendees = invitees 'End If 'if we are passed a linking document and the name of a rich text field 'then process accordingly, else just write out the comment to the Body field If Not(docLink Is Nothing) And RTFField <> "" Then Call handleRichTextItem(docNew, docLink, IncludeLink, RTFField, comment) Else .Body = comment$ End If .IsInfolineEntry = "YES" If iAlarm = 6 Then 'Alarm .~$AlarmDescription = sSubject .~$Alarm = 1 .~$AlarmOffset = -1440 .Alarms = "1" '.~$AlarmSound = "notify" End If End With End Sub Sub createRepeatFields(doc As NotesDocument, vCalStartDates As Variant, _ vCalEndDates As Variant, RepeatFlags As Variant) 'RepeatFlags(0) = RepeatForUnit 'RepeatFlags(1) = RepeatHow 'RepeatFlags(2) = RepeatInterval 'RepeatFlags(3) = RepeatUnit 'RepeatFlags(4) = RepeatWeekends 'Fields for Repeat doc.OrgRepeat = "1" doc.Repeats = "1" doc.~$CSFlags = "c" doc.~$CSVersion = "2" doc.RepeatDates = vCalStartDates doc.RepeatEndDates = vCalEndDates doc.RepeatFor = Ubound(vCalStartDates) 'iRepeat doc.RepeatForUnit = RepeatFlags(0) doc.RepeatHow = RepeatFlags(1) doc.RepeatInterval = RepeatFlags(2) doc.RepeatInstanceDates = vCalStartDates doc.RepeatStartDate = vCalStartDates doc.RepeatUnit = RepeatFlags(3) doc.RepeatWeekends = RepeatFlags(4) doc.~$HFFlags = "1" doc.~$SMTPKeepNotesItem = "1" Dim atCSWISL (0 To 4) As String atCSWISL(0)="$S:1" atCSWISL(1)="$L:1" atCSWISL(2)="$B:1" atCSWISL(3)="$R:1" atCSWISL(4)="$E:1" doc.ReplaceItemValue "$CSWISL", atCSWISL Dim atWatched (0 To 4) As String atWatched(0)="$S" atWatched(1)="$L" atWatched(2)="$B" atWatched(3)="$R" atWatched(4)="$E" doc.ReplaceItemValue "$WatchedItems", atWatched End Sub Function handleRichTextItem(docTarget As NotesDocument, docLink As Notesdocument,_ IncludeLink As Boolean, RTFField As String, comment As String) As Boolean HandleRichTextItem = False Dim rtitem As notesrichtextitem Dim rtnav As notesrichtextnavigator 'This function will copy a rich text item from a source doc to the new calendar entry, 'and it will also create a doc link to the source document if required. 'Otherwise it will simply append the comment the Body field of the new calendar entry Set rtitem = docLink.GetFirstItem(RTFField) If Not(rtitem Is Nothing) Then 'not a new doc, so we can access the rich text body field If rtitem.GetUnFormattedText <> "" Then 'see if we have data in the field If IncludeLink = True Then Call rtitem.CopyItemToDocument(DocTarget, "Body") Set rtitem = docTarget.GetFirstItem("Body") Set rtnav=rtitem.CreateNavigator If Not rtnav Is Nothing Then Call rtnav.FindFirstElement(RTELEM_TYPE_TEXTPARAGRAPH) Call rtitem.BeginInsert( rtnav, False ) 'move to beginning of rich text item Call rtItem.AppendText(comment$ & " -->") Call rtitem.AppendDocLink( docLink, "Link" ) Call rtitem.AddNewline(2) Call rtitem.AppendText("---------------------------------------------------------------------------------------") Call rtitem.AddNewline(2) Call rtitem.EndInsert() Call rtitem.update End If Else Call rtitem.CopyItemToDocument(DocTarget, "Body") Set rtitem = docTarget.GetFirstItem("Body") Call rtitem.AddNewline(2) Call rtItem.AppendText(comment$) End If Else 'either it's a new document or there are no values in the field Set rtitem = New NotesRichTextItem( docTarget, "Body" ) If Not(rtitem Is Nothing) Then If IncludeLink = True Then Call rtItem.AppendText(comment$ & " -->") Call rtitem.AppendDocLink( docLink, "Link" ) Call rtitem.addnewline(2) Call rtItem.AppendText("---------------------------------------------------------") Call rtitem.update Else docTarget.Body = comment$ End If Else docTarget.Body = comment$ End If End If End If HandleRichTextItem = True End Function
Last Wiki Answer Submitted:  November 22, 2006  2:28 pm  by  Kmpgmr   290 pts.
All Answer Wiki Contributors:  Kmpgmr   290 pts.
To see all answers submitted to the Answer Wiki: View Answer History.


Discuss This Question:
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _


 

Don’t know right now, but i will have the same request to do in few days…
So, if there is a “best practice” solution posted here, i will implement it too…

 4,075 pts.