Our company has migrated to Outlook mail however we are still using the Notes databases. I have an agent for a database where a user signs up for an event, the registration is e-mailed to them and then the entry is placed on the users calendar. Everything works with the exception of the entry is not being placed on the Outlook calendar. So I need help re-writing this agent. Does anyone have any suggestions?
Option Public
Option Declare
Use “OpenLogFunctions”
Use “Signups”
Dim session As NotesSession
Dim db As NotesDatabase
Dim vc As NotesViewEntryCollection
Dim entry As NotesViewEntry
Dim sview As NotesView
Dim wview As NotesView
Dim eview As NotesView
Dim doc As NotesDocument ’ SignUp document
Dim docEvent As NotesDocument ’ Event document – parent of SignUp document
Dim svc As NotesViewEntryCollection
Dim wvc As NotesViewEntryCollection
Dim eid As String
Dim snum As Variant
Dim wnum As Variant
Dim cap As Long
Sub Initialize
On Error Goto Err_Init
'Count Signups. 2004-10-29 Adapted from earlier version.
'Check vwSignupsPending view for newly submitted SignUp forms.
'If none, end agent.
'If anything, loop through contents and update the CountSignups field in the Event form.
'If Event is now full, add user to wait list.
'For each submission, send email to user confirming registration.
'This agent has to run on the server on a schedule because the user can't necessarily
'see other responses to the event. So, computed on display fields and such won't work.
Dim view As NotesView
Dim count As Integer
Set session = New NotesSession
Set db = session.CurrentDatabase
Set view = db.GetView("vwSignUpsPending")
Set vc = view.AllEntries
count = 0
'Proceed only if view contains entries.
If vc.count > 0 Then
Set sview = db.GetView("vwSignUpsByEventID")
Set wview = db.GetView("vwWaitListByEventID")
Set eview = db.GetView("vEventsByEventID")
Set entry = vc.GetFirstEntry( )
While Not (entry Is Nothing)
Set doc = entry.Document 'signup doc to process
Call sview.Refresh
eid = doc.fldEventID(0)
Set svc = sview.GetAllEntriesByKey( eid ) 'all signups for event
snum = svc.Count
Set docEvent = eview.GetDocumentByKey( eid )
If Not docEvent Is Nothing Then
'compare capacity with current signup count
cap = docEvent.fldEventCapacity(0) 'get maximum # of attendees allowed
If snum >= cap Then 'if event is full, add user to wait list
doc.fldWaitList = "Yes"
Else
doc.fldWaitList = "" 'remove them from wait list of it's opened up since they submitted
End If
doc.fldPending = "" 'set signup as not pending any longer
Call doc.Save(True,True)
'Update signup and wait list counts
UpdateEventCounts eid 'call to Signups library
SendMemo 'For each submission, send email to user confirming registration.
AddToCalendar 'add event to user's calendar
count = count + 1
End If
'Then go get the next SignUp document
Set entry = vc.GetNextEntry(entry)
Wend
End If
Call LogEvent("Agent Completed Successfully. " & Cstr(count) & " sign-ups processed", SEVERITY_LOW, Nothing)
Exit_Init:
Exit Sub
Err_Init:
Call LogErrorEx(Error$, SEVERITY_HIGH, Nothing)
Resume Exit_Init
End Sub
Sub SendMemo
'send email to user confirming registration
Dim docMemo As NotesDocument ' mail message to Respondent
Dim rtitem As NotesRichTextItem
Set docMemo = New NotesDocument( db )
docMemo.Form = "Memo"
docMemo.SendTo = doc.Respondent(0)
Set rtitem = New NotesRichTextItem( docMemo, "Body" )
Call rtitem.AppendDocLink( doc, db.Title )
Call rtitem.AddTab( 1 )
Call rtitem.AppendText( doc.EventTitle( 0 ) )
Call rtitem.AddNewLine( 2 )
If doc.fldWaitList(0) = "Yes" Then
docMemo.Subject = "Event Waiting List Registration confirmed"
Call rtitem.AppendText( "You are on the waiting list for this event.")
Else
docMemo.Subject = "Event Registration confirmed"
Call rtitem.AppendText( "You are registered for this event.")
End If
Call rtitem.AddNewLine( 1 )
Call rtitem.AppendText( "Select the link above to open the event. This event has been added to " &_
"your calendar and you will receive an email notification (Press F9 to refresh your calendar, if " &_
"currently open). NOTE: If you wish to receive a pop-up reminder about this Event, be sure to " &_
"check ""Notify Me"" on the calendar entry once you receive it.")
Call docMemo.Send( False )
End Sub
Sub AddToCalendar
'Add To Calendar. Version 2004-07-06
'2004-04-27: On click, create calendar entry in current user's personal calendar for this event.
'Adapted from LDD post by Ben Rodway on 12.Jan.04
'2004-07-06: added doclink to original
'2004-10-28: made it send instead of saving in the database, which is how calendaring works.
' User will get email notification of it now as well. Added From, RoomToReserve & Location fields.
'2005-01-19: set it to not enable the alarm notification, since user should manually do this so it user their defaults
'2005-02-02: moved from Signup & Event forms to here so it happens automatically now
Dim AlarmTime As NotesDateTime
Dim mailDoc As NotesDocument
Dim rtitemThisDoc As Variant
Dim rtitem As Variant
Dim dateitem As NotesItem
Dim timeitem As NotesItem
Dim respName As New NotesName( doc.Respondent(0) )
Dim fullRespondent As String
Set mailDoc = New NotesDocument( db )
fullRespondent = respName.Canonical
mailDoc.Form = "Appointment"
mailDoc.AppointmentType = "3" 'i.e., "Meeting".
mailDoc.MeetingType = "1"
mailDoc.Principal = fullRespondent
mailDoc.Subject="Event: " & doc.EventTitle(0)
mailDoc.Location = doc.EventLocation(0)
mailDoc.RoomToReserve = doc.EventRoom(0)
'First set start date/time, and all the other fields that need to be equivalent to the start date/time
Set dateitem = doc.GetFirstItem("EventStartDate")
Set timeitem = doc.GetFirstItem("EventStartTime")
Set AlarmTime = New NotesDateTime(dateitem.DateTimeValue.DateOnly & " " & timeitem.DateTimeValue.TimeOnly)
’ Call mailDoc.ReplaceItemValue(“$AlarmTime”, AlarmTime.LSLocalTime)
Call mailDoc.ReplaceItemValue("$NoPurge", AlarmTime.LSLocalTime)
’ Call mailDoc.ReplaceItemValue(“$AlarmDescription” , mailDoc.Subject(0))
mailDoc.StartDateTime=AlarmTime.LSLocalTime
mailDoc.ReminderTime=AlarmTime.LSLocalTime
mailDoc.CalendarDateTime=AlarmTime.LSLocalTime
'Then, set the end date/time
Set timeitem = doc.GetFirstItem("EventEndTime")
Set AlarmTime = New NotesDateTime(dateitem.DateTimeValue.DateOnly & " " & timeitem.DateTimeValue.TimeOnly)
mailDoc.EndDateTime=AlarmTime.LSLocalTime
'Then bring the EventDescription field into the calendar entry's Body field
Set rtitemThisDoc = doc.GetFirstItem("EventDescription")
If rtitemThisDoc.Type = RICHTEXT Then
’ Call rtitemThisDoc.CopyItemToDocument(mailDoc, “Body”) 'doesn’t work, causes corruption since rtf is computed
Set rtitem = mailDoc.CreateRichTextItem( "Body" )
Call rtitem.AppendText( rtitemThisDoc.GetUnformattedText( ) )
Call rtitem.AddNewLine(1)
Call rtitem.AppendText("DocLink to Event SignUp --> ")
Call rtitem.AppendDocLink( doc, doc.EventTitle(0) )
End If
'Then set Location
'Then set all the other piddly little fields that need to be set.
mailDoc.BookFreeTime=""
mailDoc.CHAIR=fullRespondent
’ mailDoc.ORGDONTDOUBLEBOOK=“”
mailDoc.ORGTABLE="C0"
mailDoc.tmpApptFlags=""
Call mailDoc.ReplaceItemValue("_ViewIcon" , 158)
’ Call mailDoc.ReplaceItemValue(“$Alarm” , 1) don’t set, since it misleads users, they should manually enable the alarm so it takes their default settings
Call mailDoc.ReplaceItemValue("$BusyPriority" , "1")
Call mailDoc.ReplaceItemValue("$PublicAccess" , "1")
Call mailDoc.ReplaceItemValue("$BusyName" , fullRespondent)
Call mailDoc.ReplaceItemValue("$PrevBusyName" , fullRespondent)
mailDoc.tmpWasMailed = "1"
mailDoc.ExcludeFromView="D" 'ensures it doesn't appear in drafts view
’ mailDoc.RemoveItem(“$AlarmOffset”)
mailDoc.Logo = "stdNotesLtr0"
mailDoc.From = fullRespondent
mailDoc.SendTo = fullRespondent
Call mailDoc.Send(False)
End Sub