Created Appointments by LS appears in Trash-----------------------------------------------------
Scince i got no feedback to my Question, i will try again.
Hope to get Feedbacks to my Question and thanks in advance.
My LotusScript code within a external notes database have to create calander entries into the current user’s mailbox, the currently created appointment will be opened in edit mode, so the user can edit and save this one.
The Problem is that the Appointment will be placed into the trash folder of user’s mailbox!
Do anybody have a Idea, what the reason can be?
hier my Code…
###################################################################################################################
Sub Click(Source As Button) 'Creating/Modifying Calander Entry
'-------- En cas d’erreur lors de la récupération de l’entrée dans l’agenda, on recréé le doc
On Error 4091 Goto CreateNewEntry
'-------- Variables ------------------------------------------------------------------------------------------------------------------
Dim uiws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim docProfile As NotesDocument
Dim uidocMail As NotesUIDocument
Dim ndbCurrent As NotesDatabase
Dim iCpt As Integer
Dim iFlag As Integer
Dim subObjCRMApp As CRMApplication
Dim rtBodyItem As NotesRichTextItem
Dim rtBodyItem2 As NotesRichTextItem
Dim rtStyle As NotesRichTextStyle
Dim it As NotesItem
Dim it1 As NotesItem
Dim it2 As NotesItem
Dim it3 As NotesItem
Dim it4 As NotesItem
Dim sAddress As String
Dim vPhoneTypes As Variant
Dim vPhone As Variant
Dim sDate As String
Dim sDateTime As String
Dim sTime As String
'--------initialisation of current document------------------------------------------------------------------------------------------------------------------
Set subobjCRMApp = New CRMApplication (“”, “”)
Set sesCurrent = New NotesSession
Set ndbCurrent = sesCurrent.CurrentDatabase
Set uidoc = uiws.CurrentDocument
Set docCurrent = uidoc.Document
'-----verification of date and time fields
If Not (Isdate(Cstr(docCurrent.dtContNextContactDate(0)))) Or Not Isdate(Cstr(docCurrent.dtContBegins(0))) Then Exit Sub
sDate = Cstr(docCurrent.dtContNextContactDate(0))
sTime = Cstr(docCurrent.dtContBegins(0))
sDateTime = sDate & " " & sTime
'------ User’s Mail verification ----------------
If Not initDbMail() Then
Exit Sub
End If
'------ reschedule the existing Appointment ----------------
Set docProfile = subObjCRMApp.m_ndbCurrent.getProfileDocument(“SystemProfile”)
If docProfile.getItemValue(“sp_tUpdateCalendar”)(0) = “1” Then
If docCurrent.tCalendarEntryID(0) <> “” Then
Set docMail = ndbMail.GetDocumentByUnID(docCurrent.tCalendarEntryID(0))
'-----------change Calendar entry
If sDateTime <> Cstr(docMail.StartDate(0)) & " " & Cstr(docMail.StartTime(0)) Then
Msgbox “Your calendar entry is rescheduled, please ckeck the end date and end time and save it!”, 64 , “Change calendar entry”
If Not setMyDateTime (sDate, sTime) Then Exit Sub
End If
'-------
Call uiws.editDocument(True,docMail)
Exit Sub
End If
End If
CreateNewEntry:
Call sesCurrent.SetEnvironmentVar(“CSDocType”, “4”, True)
Set rtStyle = sesCurrent.CreateRichTextStyle
Set docMail = New NotesDocument(ndbMail)
docMail.Form = “Appointment”
docMail.AppointmentType = “0”
Call docMail.ReplaceItemValue(“$CSVersion”, “2”)
'----- Build body field --------------------------------------------------------------------------------
Set rtBodyItem = New NotesRichTextItem(docMail,“Body”)
'----- Add Title, DocLinks, etc. to body -------------------------------------------------------------------------------------------------
Call rtBodyItem.AddNewLine(1)
rtStyle.Bold = True
'…
'------- Other fileds --------------------------------------------------------------------------------
Set it1 = New NotesItem (docMail, “$BusyPriority”, “1”)
Set it2 = New NotesItem (docMail, “$PublicAccess”, “1”)
Set it3 = New NotesItem (docMail, “Chair”, sesCurrent.Username, NAMES)
Set it4 = New NotesItem (docMail, “Principal”, sesCurrent.Username, NAMES)
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
If sDate <>“” And stime <>“” Then
If Not setMyDateTime (sDate, sTime) Then Exit Sub
End If
'------ Save Calander entry -----------------------------------------
Call docMail.ComputeWithForm(True, False)
Call docMail.Save(True, False)
Sleep(2) '2s Delay
'------ open Calander entry for editing
Set uidocMail = uiws.editDocument(True,docMail)
Call uidocMail.FieldSetText(“AppointmentType”, “0”)
Call uidocMail.FieldSetText(“Subject”,“Sonia " + docCurrent.tContTemplateName(0) + " : " + docCurrent.tContSubject(0) + " (” + docCurrent.tContCompanyHierarchy(0) + “)”)
docCurrent.tCalendarEntryID = uidocMail.Document.UniversalID
Exit Sub
End Sub
###################################################################################################################
Function setMyDateTime (sdate As String, sTime As String) 'Converting date and time into NotesDateTime object
setMyDateTime = False
On Error Goto err_setMyDateTime
Dim ditDate As New NotesDateTime (sDate)
Dim ditTime As New NotesDateTime (sTime )
Dim ditDateTime As New NotesDateTime (sDate & " " & sTime )
Set docmail.StartDate = ditDate
Set docmail.EndDate = ditDate
Set docmail.StartTime = ditTime
Set docmail.StartDateTime = ditDateTime
If Hour(sTime) < 23 Then
Call ditTime.Adjusthour( 1 )
Call ditDateTime.Adjusthour( 1 )
End If
Set docmail.EndTime = ditTime
Set docmail.EndDateTime = ditDateTime
Call docMail.ReplaceItemValue(“AppointmentType”, “0”)
setMyDateTime = True
exit_setMyDateTime:
Exit Function
err_setMyDateTime:
Msgbox “Cannot change date or time in calendar!”, 16, “Error”
Resume exit_setMyDateTime
End Function
###################################################################################################################
Function initDbMail() As Variant ’
Dim asMailDbName As Variant
Dim sMailDbPath As String
Dim sMailDbServer As String
'----- Get Mail File of user ---------------------------------------------------------------------------
asMailDbName = Evaluate(“@MailDBName”)
sMailDbServer = asMailDbName(0)
sMailDbPath = asMailDbName(1)
Set ndbMail = sesCurrent.GetDatabase(sMailDbServer,sMailDbPath)
'----- Test if mail box exists ------------------------------------------------------------------------
initDbMail = True
If Not ndbMail.IsOpen Then
Messagebox GetMessage(1, 3, “[Database]”, sMailDbPath & “@” & sMailDbServer)
initDbMail = False
End If
End Function