INECO Forum Overzicht Overzicht Aanmelden Aanmelden Registreer Registreer Profiel Profiel Ledenlijst Ledenlijst Groepen Groepen Zoeken Zoeken

(Repeterende) herinnering
 
 
 
 
 Geplaatst   Bericht 
Marcel Rothuizen

Marcel Rothuizen
 

Aanmelddatum: 10-11-2000
Woonplaats: Heteren (Gld)
Datum: 01-11-2007 21:55:45    Bericht: (Repeterende) herinnering

De onderstaande code kan als basis dienen om (repeterende) agenda afspraken te maken.
Indien de Start en Eind datum op de zelfde dag vallen zal er maar een document aangemaakt worden,
indien er meerdere dagen zijn worden twee documenten gemaakt,
een verborgen document en een "response" document voor de repeternde dagen.

Option Public
Option Declare

Dim curSession As NotesSession

Sub Initialize
 
 Dim startDate As NotesDateTime
 Dim endDate As NotesDateTime
 Set startDate = New NotesDateTime(Now)
 Set endDate = New NotesDateTime(Now)
 Call endDate.AdjustDay(4)
 Call setParentDoc(startDate, endDate, "Popup: Reminder", "Reminder")
End Sub

Sub setParentDoc(StartDate As notesDateTime, EndDate As NotesDateTime, PopUp As String, Subject As String)
 
 Dim ExcludeFromView(1) As String
 Dim DateTimeList() As NotesDateTime
 Dim tmpDate As NotesDateTime
 Dim StartDateOnly As NotesDateTime
 Dim StartTimeOnly As NotesDateTime
 Dim EndDateOnly As NotesDateTime
 Dim ParentDoc As  NotesDocument
 Dim MailDb  As NotesDatabase
 Dim x As Integer
 Dim Repeat As Boolean
 Const TimeOnly$ =  "16:00 PM"
 
 Set curSession=New Notessession
 Set MailDb = New NotesDatabase("","")
 Call MailDb.OpenMail
 
 Set  ParentDoc = MailDb.CreateDocument
 ExcludeFromView(0)="D"
 ExcludeFromView(1)="S"
 
 Set StartDate = New NotesDateTime(Cstr(StartDate.DateOnly) & " " & TimeOnly$) 
 Set StartDateOnly = New NotesDateTime(StartDate.LSLocalTime)
 Call StartDateOnly.SetAnyTime
 Set StartTimeOnly = New NotesDateTime(StartDate.LSLocalTime)
 Call StartTimeOnly.SetAnyDate
 
 Set tmpDate = New NotesDateTime(Cstr(StartDate.DateOnly) & " " & Cstr(StartDate.TimeOnly))
 Set EndDate = New NotesDateTime(Cstr(EndDate.DateOnly) & " " & TimeOnly) 
 Set EndDateOnly = New NotesDateTime(EndDate.LSLocalTime)
 Call EndDateOnly.SetAnyTime
 
 x = 0 
 While (EndDate.timedifference(tmpDate) >= 0)
  Redim Preserve DateTimeList(x) As NotesDateTime  
  Set DateTimeList(x) = New NotesDateTime(Cstr(tmpDate.DateOnly) & " " & Cstr(tmpDate.TimeOnly))  
  Call tmpDate.AdjustDay(1)
  x = x + 1
 Wend
 
 If Ubound(DateTimeList) > 0 Then
  Repeat = True  
 End If
 
 With ParentDoc
  Call .ReplaceItemValue("$Alarm", 1)
  Call .ReplaceItemValue("$AlarmDescription", PopUp)
  Call .ReplaceItemValue("$AlarmMemoOptions", "")
  Call .ReplaceItemValue("$AlarmOffset", -1)
  Call .ReplaceItemValue("$AlarmSound","tada")
  Call .ReplaceItemValue("$AlarmUnit", "M")
  Call .ReplaceItemValue("$AltPrincipal",curSession.UserName )
  Call .ReplaceItemValue("$CSVersion","2")
  Call .ReplaceItemValue("$NoPurge",EndDate)
  Call .ReplaceItemValue("$PublicAccess","1")
  Call .ReplaceItemValue("Alarms","1")
  Call .ReplaceItemValue("AltChair",curSession.UserName )
  Call .ReplaceItemValue("AppointmentType","4")
  Call .ReplaceItemValue("ApptUNID",Cstr(ParentDoc.UniversalID))
  Call .ReplaceItemValue("Chair",curSession.UserName)
  Call .ReplaceItemValue("EndDate",StartDateOnly)
  Call .ReplaceItemValue("EndDateTime",StartDate.lsLocaltime)
  Call .ReplaceItemValue("EndTime",StartTimeOnly)
  Call .ReplaceItemValue("ExcludeFromView",ExcludeFromView)
  Call .ReplaceItemValue("Form","Appointment")
  Call .ReplaceItemValue("From",curSession.UserName )
  Call .ReplaceItemValue("MeetingType","1")
  Call .ReplaceItemValue("OrgTable","C0")
  If Repeat Then
   Call .ReplaceItemValue("$CSFlags","c")
   Call .ReplaceItemValue("OrgRepeat","1")
   Call .ReplaceItemValue("RepeatCustom",StartDateOnly)
   Call .ReplaceItemValue("RepeatDates",DateTimeList)
   Call .ReplaceItemValue("RepeatEndDates",DateTimeList)
   Call .ReplaceItemValue("RepeatFor",Ubound(DateTimeList)+1)
   Call .ReplaceItemValue("RepeatForUnit","D")
   Call .ReplaceItemValue("RepeatUnit","D")
   Call .ReplaceItemValue("RepeatFromEnd","")
   Call .ReplaceItemValue("RepeatHow","F")
   Call .ReplaceItemValue("RepeatInstanceDates",DateTimeList)
   Call .ReplaceItemValue("RepeatInterval","1")
   Call .ReplaceItemValue("Repeats","1")
   Call .ReplaceItemValue("RepeatStartDate",StartDate.lsLocaltime)
   Call .ReplaceItemValue("RepeatUntil",EndDateOnly)
   Call .ReplaceItemValue("RepeatWeekends","D")
  Else
   Call .ReplaceItemValue("CalendarDateTime",StartDate.lsLocaltime)
  End If
  
  Call .ReplaceItemValue("Principal",curSession.UserName)
  Call .ReplaceItemValue("SchedulerSwitcher","1")
  Call .ReplaceItemValue("SequenceNum",1)
  Call .ReplaceItemValue("StartDate",StartDateOnly)
  Call .ReplaceItemValue("StartTime",StartTimeOnly)
  Call .ReplaceItemValue("StartDateTIME",StartDate.lsLocaltime )
  Call .ReplaceItemValue("Subject",Subject)
  Call .ReplaceItemValue("tmpAdditionalInviteeButton","1")
  Call .ReplaceItemValue("tmpAdditionalRoomsButton","1")
  Call .ReplaceItemValue("tmpAppointmentType","Reminder")
  Call .ReplaceItemValue("tmpAppointmentType_1","Reminder")
  Call .ReplaceItemValue("tmpChair",curSession.UserName )
  Call .ReplaceItemValue("tmpEventLabel","Reminder")
  Call .ReplaceItemValue("tmpOwnerHW","0")
  Call .ReplaceItemValue("tmpParticipantHW","1")
  Call .ReplaceItemValue("tmpRW","1")
  Call .ReplaceItemValue("tmpShowTZ","0")
  Call .ReplaceItemValue("txtNum",Cstr(Ubound(DateTimeList) + 1))
  Call .ReplaceItemValue("UpdateSeq",1)
  Call .ReplaceItemValue("WebDateTimeInit","1")
  Call .ReplaceItemValue("_viewIcon", 10)
  Call .ComputeWithForm(True,False)
  Call .Save(True, False)
  If Not Repeat Then
   .PutInFolder( "$Alarms" )
  End If
 End With  
 
 If Repeat Then
  Call setResponseDoc(MailDb, ParentDoc, StartDate, EndDate, Popup, Subject , DateTimeList)
 End If
 
End Sub

Sub setResponseDoc( MailDb As NotesDatabase , ParentDoc As notesDocument, StartDate As notesDateTime, EndDate As NotesDateTime, PopUp As String, Subject As String, DateTimeList As Variant)
 
 Dim ResponseDoc As NotesDocument
 Dim ExcludeFromView(1) As String
 Dim StartDateOnly As NotesDateTime
 Dim StartTimeOnly As NotesDateTime
 
 Set StartDateOnly = New NotesDateTime(StartDate.LSLocalTime)
 Call StartDateOnly.SetAnyTime
 Set StartTimeOnly = New NotesDateTime(StartDate.LSLocalTime)
 Call StartTimeOnly.SetAnyDate
 
 ExcludeFromView(0)="D"
 ExcludeFromView(1)="S"
 Set ResponseDoc=MailDb.CreateDocument
 
 With ResponseDoc
  Call .MakeResponse(ParentDoc)
  Call .ReplaceItemValue("$Alarm", 1)
  Call .ReplaceItemValue("$AlarmDescription", PopUp)
  Call .ReplaceItemValue("$AlarmMemoOptions", "")
  Call .ReplaceItemValue("$AlarmOffset", -1)
  Call .ReplaceItemValue("$AlarmSound","tada")
  Call .ReplaceItemValue("$AlarmUnit", "M")
  Call .ReplaceItemValue("$AltPrincipal",curSession.UserName )
  Call .ReplaceItemValue("$CSFlags","i")
  Call .ReplaceItemValue("$CSVersion","2")
  Call .ReplaceItemValue("$NoPurge",EndDate)
  Call .ReplaceItemValue("$PublicAccess","1")
  Call .ReplaceItemValue("$RefOptions","1")
  Call .ReplaceItemValue("Alarms","1")
  Call .ReplaceItemValue("AltChair",curSession.UserName )
  Call .ReplaceItemValue("AppointmentType","4")
  Call .ReplaceItemValue("ApptUNID",Cstr(ParentDoc.UniversalID))
  Call .ReplaceItemValue("CalendarDateTime",DateTimeList )
  Call .ReplaceItemValue("Chair",curSession.UserName)
  Call .ReplaceItemValue("EndDate",StartDateOnly)
  Call .ReplaceItemValue("EndDateTime",DateTimeList)
  Call .ReplaceItemValue("EndTime",StartTimeOnly)
  Call .ReplaceItemValue("ExcludeFromView",ExcludeFromView)
  Call .ReplaceItemValue("Form","Appointment")
  Call .ReplaceItemValue("From",curSession.UserName )
  Call .ReplaceItemValue("MeetingType","1")
  Call .ReplaceItemValue("OrgRepeat","1")
  Call .ReplaceItemValue("OrgTable","C0")
  Call .ReplaceItemValue("Principal",curSession.UserName )
  Call .ReplaceItemValue("RepeatInstanceDates",DateTimeList)
  Call .ReplaceItemValue("Repeats","1")
  Call .ReplaceItemValue("SchedulerSwitcher","1")
  Call .ReplaceItemValue("SequenceNum",1)
  Call .ReplaceItemValue("StartDate",StartDate.lsLocaltime)
  Call .ReplaceItemValue("StartTime",StartTimeOnly)
  Call .ReplaceItemValue("StartDateTIME",DateTimeList)
  Call .ReplaceItemValue("Subject",Subject)
  Call .ReplaceItemValue("txtNum",Cstr(Ubound(DateTimeList) + 1))
  Call .ReplaceItemValue("UpdateSeq",1)
  Call .ReplaceItemValue("WebDateTimeInit","1")
  Call .ReplaceItemValue("_viewIcon", 10 )
  Call .ComputeWithForm(True,False)
  Call .Save(True, False )
  Call .PutInFolder( "$Alarms" )
 End With 
 
End Sub

 E-mail Website ICQ MSNM Skype Hyves LinkedIn 
Zoek in afgelopen ok
 
   Overzicht / Lotus Notes Ontwikkeling / Lotusscript  
Pagina 1 van 1 

IBM LOTUS NOTES migratie doet u samen met INECO

Powered by Lotus Domino R8.5.3 on Fedora Core 14 Dit  forum is gemaakt door Intranet &  Network Consultancy. © 2011.
Voor vragen of opmerkingen  kunt u contact opnemen met:  .
Deze site is gemaakt met Lotus Notes R8.5.3 en draait op Fedora Core 14.

INECO Support Contract banner