'Public Sub SendNotesAppointment(Username as string, Subject as string,
'Body as string, AppDate as Date, StartTime as Date, MinsDuration as
integer)
'This public sub will write an appointment to a persons diary
'You must have write privleges to the calendar of the user you are going to add an appointment for
'Username is the name of the user's mail database, used to get database
'Also change the servername to reflect the notes server name
Public Sub SendNotesAppointment(UserName As String, Subject As String, Body As String, AppDate As Date, StartTime As Date, MinsDuration As Integer)
'Set up the objects required for Automation into lotus notes
Dim MailDbName As String 'The persons notes mail database name
Dim strSTime As String
Dim strETime As String
Dim CalenDoc As Object 'The calendar entry itself
Dim WorkSpace As Object
Dim ErrCnt As Integer
Set WorkSpace = CreateObject("Notes.NOTESUIWORKSPACE")
'Change this to fit your particular db naming convention based on UserName if necessary
MailDbName = "mail\" + UserName + ".nsf"
strSTime = CStr(FormatDateTime(StartTime, vbShortTime))
strETime = CStr(FormatDateTime(DateAdd("n", MinsDuration, StartTime), vbShortTime))
'MAKE SURE TO SET SERVER NAME BELOW
Set CalenDoc = WorkSpace.COMPOSEDOCUMENT("***SERVERNAME***", MailDbName, "Appointment")
CalenDoc.FIELDSETTEXT "AppointmentType", "0"
CalenDoc.Refresh
'Each loop is used to write the value to the field until the field is changed to that value
Do Until (CDate(Right(CalenDoc.fieldgettext("StartDate"), 10)) = CDate(AppDate)) Or ErrCnt = 1000
CalenDoc.FIELDSETTEXT "StartDate", CStr(FormatDateTime(AppDate, vbShortDate))
CalenDoc.Refresh
'ErrCnt is used to prevent an endless loop
ErrCnt = ErrCnt + 1
Loop
ErrCnt = 0
Do Until (CDate(CalenDoc.fieldgettext("StartTime")) = CDate(strSTime)) Or ErrCnt = 1000
CalenDoc.FIELDSETTEXT "StartTime", strSTime
CalenDoc.Refresh
ErrCnt = ErrCnt + 1
Loop
ErrCnt = 0
Do Until (CDate(Right(CalenDoc.fieldgettext("EndDate"), 10)) = CDate(AppDate)) Or ErrCnt = 1000
CalenDoc.FIELDSETTEXT "EndDate", CStr(FormatDateTime(AppDate, vbShortDate))
CalenDoc.Refresh
ErrCnt = ErrCnt + 1
Loop
ErrCnt = 0
Do Until (CDate(CalenDoc.fieldgettext("EndTime")) = CDate(strETime)) Or ErrCnt = 1000
CalenDoc.FIELDSETTEXT "EndTime", strETime
CalenDoc.Refresh
ErrCnt = ErrCnt + 1
Loop
CalenDoc.FIELDSETTEXT "Subject", Subject
CalenDoc.FIELDSETTEXT "Body", Body
CalenDoc.Refresh
CalenDoc.Save
CalenDoc.Close
Set CalenDoc = Nothing
Set WorkSpace = Nothing
End Sub