Remainder Mail agent - lotus-notes

I have form with 3 fields adress,status,ReportingDate.
Adress field contains the ID where the mil has to be sent.
Now I have created an agent where it should mail to the data present in adress field when status is incomplete and reporting date is exactly 7 days before todays date.
My Code:
Option Public
Option Declare
Sub Initialize
Dim sess As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim timestamp As New NotesDateTime("Today")
Dim Noresponsedate As NotesDateTime
Dim vw As NotesView
Dim diff As Integer
Dim SendTo As Variant
Call timestamp.SetNow()
Set db = sess.CurrentDatabase
Set vw = db.GetView( "data" )
Set doc = vw.GetFirstDocument()
While Not doc Is Nothing
If doc.Status(0) = "Incomplete" Then
Call checktimedifference(doc)
End if
Set doc = vw.GetNextDocument(doc)
wend
End Sub
Sub checktimedifference(doc As NotesDocument)
Dim due As NotesDateTime
Dim present As NotesDateTime
Dim timecheck As variant
Set due = New NotesDateTime ( "" )
Set present = New NotesDateTime ( "Today" )
timecheck = doc.ReportingDate(0)
due.LSLocalTime = timecheck
If due.TimeDifference (present) = -604800 Then
Call sendmailtouser(doc)
End If
End Sub
Sub sendmailtouser(doc As NotesDocument)
Dim db As NotesDatabase
Dim rtiitem As NotesRichTextItem
Dim maildoc As NotesDocument
dim recepient As variant
Set maildoc = New NotesDocument( db )
Set rtiitem = New NotesRichTextItem( maildoc, "Body" )
recepient = doc.adress(0)
maildoc.from = db.Title
maildoc.form = "memo"
maildoc.subject = "A Minor Injury Report:" & doc.Seq_No(0) & " needs your response"
maildoc.SendTo = recepient
Call rtiitem.AppendText( "Please respond to this Minor Injury Report" )
Call rtiitem.AddNewline( 2 )
Call rtiitem.AppendText( "Your response for the Minor Injury Report: " & doc.Seq_No(0) & " is required" )
Call rtiitem.AddNewline( 2 )
Call rtiitem.AppendText( "Please click on the following link to access the document.")
Call rtiitem.AppendDocLink( doc, db.Title )
Call maildoc.Send(False)
End Sub
When I am running the agent on client I am getting the following error:
Please help me to solve the error and send mail to the recepients.

Not using any error handling is very bad practice. But your error will most probably happen in the sendmailtouser- sub, where you dim a local notesdatabase- object named db without actually initializing it.
The line
set maildoc = New NotesDocument( db )
will fail.
Either declare db globally and set it in your initialize or dim ses in that sub again and set db again (worst case as you have to do it for every document)

Related

Can we able to export the file using Freefile with form fields instead of views in lotus notes

I'm trying to generate a csv file from lotus notes. Is it possible to get field values from form using freefile? In my case the views doesn't show all the fields which i'm looking for. I have referred some of the sites but no answer. Please help me.
Thanks in advance
I have tried this code atleast to print header but its not working
Dim db As NotesDatabase
Dim uiview As NotesUIView
Dim vw As NotesView
Dim doc As NotesDocument
Dim form As NotesForm
Dim session As NotesSession
Dim Field As NotesItem
Dim fileName As variant
Dim Date1(1 To 3) As String
Dim headerString As String
Dim header As Variant
Dim fieldString As String
Dim fieldList As Variant
Dim i As Long, j As Long,seqno As Integer,count As Long
Dim fileNum As Integer
Dim rowstring As String
Dim cns As String
Sub Initialize
Set uiview = ws.CurrentView
Set view = uiview.View
Set session=New NotesSession
Set db = session.CurrentDatabase
fileName = ws.SaveFileDialog(False,"File name",, "E:\samp" & ".csv")
Call Exit_Form(db)
End Sub
Function Exit_Form(db As NotesDatabase)
fileNum% = FreeFile()
Open fileName For Output As fileNum%
On Error GoTo errorhandler
headerString ="UNID,S.No,SectionName,Year,Discount,Formula,Final Price"
header = Split(UCase(headerString),",")
Set form=db2.Getform("Form1")
i=1
j=1
count1=0
ForAll a In header
Print #fileNum%, a
End ForAll
errorhandler:
MsgBox "ExitForm function" +Error + CStr(Erl)
Exit Function
End Function
You are using the wrong classes.
A "Form" is a design element to show "Documents" in a NotesDatabase. There is no information about the data in there.
You need to get NotesDocument- Objects, and from there you can read the data using GetItemValue- Method.
In addition I would not use the "antique" technique of freefile but use the class "NotesStream" for it.
To e.g. export all documents in a database (means: all different forms are used) you can do something like:
Dim ses as New NotesSession
Dim db as NotesDatabase
Dim dc as NotesDocumentCollection
Dim doc as NotesDocument
Dim stream as NotesStream
Dim lineInFile as String
Dim itemList as Variant
Dim i as Integer
Set db = ses.CurrentDatabase
Set dc = db.AllDocuments
Set stream = ses.CreateStream
....
Call stream.Open( fileName )
Call stream.WriteText( headerLine, EOL_CRLF )
itemList = Split( "ItemFromDocument1,ItemFromDocument2,...", "," )
Set doc = dc.GetFirstDocument()
While not doc is Nothing
For i = 0 to ubound( itemList )
If i = 0 then
writeLine = Cstr( doc.GetItemValue( itemList(i) )(0) )
Else
writeLine = writeList & "," & Cstr( doc.GetItemValue( itemList(i) )(0) )
End If
Next
Call stream.WriteText( writeLine, EOL_CRLF )
Set doc = dc.GetNextDocument(doc)
Wend
Call stream.Close
You could do the same with all documents in a specific folder or view:
Dim view as NotesView
Set view = db.GetView( "NameOfFolderOrView" )
...
Set doc = view.GetFirstDocument()
While not doc is Nothing
...
Set doc = view.GetNextDocument( doc )
Wend
Beware: This approach is quite ugly. It does not consider multi value fields, it does not escape commas that are probably in one of the field values and it does not have any error handling... but at least it is a start.

Error Sending automation mail after registration using lotus script

Question:
1. My question why after registration of an user still not listed in domino directory?
Case:
I am using xPages form call lotus script agent.
All my script is using lotus script to register an user.
After Complete register an email, need to send automation notification mail to user as welcome mail.
when i complete registration, i want to send mail, it give me an error message:
1.unable to deliver message 'ChunWH#devsvr1.pcs.com.my'
2.User 'ChunWH#devsvr1.pcs.com.my' not listed in Domino Directory
Register user Agent
Option Public
Option Declare
Sub Initialize
On Error GoTo ErrorHandler
Dim s As New NotesSession, db As NotesDatabase, a As NotesAgent
Dim doc As NotesDocument
Set db = s.Currentdatabase
Set a = s.Currentagent
Set doc = s.Documentcontext ' uidoc
Dim maildoc As NotesDocument, body As NotesMIMEEntity
Dim stream As NotesStream
Dim groups
groups = Null
groups = group(groups,"Everyone")
Dim certid As String ' full path of cert id
Dim certpasswd As String
Dim OU As String
Dim lastname As String
Dim firstname As String
Dim middleinit As String
Dim usrIdpath As String
Dim mailsvr As String
Dim mailfile As String
Dim userpasswd As String
Dim internetpathLength As String
Dim internetpath As String
Dim remapuserID As String
Dim depvw As NotesView, depdoc As NotesDocument
Set depvw = db.Getview("Department sort by dept")
Set depdoc = depvw.Getdocumentbykey(doc.Dept(0), True)
If Not depdoc Is Nothing Then
certid = depdoc.IdPath(0)
certpasswd = depdoc.IdPassword(0)
OU = ""
lastname= doc.Name(0)
firstname = ""
middleinit = ""
usrIdpath = depdoc.DptIdStor(0) +doc.SelectMail(0)+ ".id"
' remove "." replace with empty and remove the empty space
remapuserID = remapChr(doc.SelectMail(0)) ' this is remapuserID
mailsvr = depdoc.MailSvr(0) ' mail svr
' Mail file name also cannot have . in between for example, mail/test1.apple, reason window not understand it
mailfile = depdoc.MailLocation(0)+ remapuserID ' Mail\Person
userpasswd= depdoc.UserPassword(0)
internetpath = doc.SelectMail(0)+depdoc.InternetPath(0) ' mail address
internetpathLength = Len(depdoc.InternetPath(0)) ' not used
End If
Dim reg As New NotesRegistration
Dim dt As Variant
dt = DateNumber(Year(Today)+1, Month(Today), Day(Today))
reg.RegistrationServer = mailsvr
reg.CreateMailDb = True '
reg.CertifierIDFile = certid
reg.Expiration = dt
reg.IDType = ID_HIERARCHICAL
reg.MinPasswordLength = 1
reg.IsNorthAmerican = True
reg.OrgUnit = OU
reg.RegistrationLog = "log.nsf"
reg.UpdateAddressBook = True
reg.Storeidinaddressbook = false
reg.MailInternetAddress = internetpath
reg.Shortname=doc.SelectMail(0)
reg.Mailowneraccess =2
reg.Mailcreateftindex=True
reg.Mailaclmanager ="LocalDomainAdmins"
reg.Grouplist=groups
Call reg.RegisterNewUser(lastname, _
usridpath, _
mailsvr, _
firstname, _
middleInit, _
certpasswd, _
"", _
"", _
mailfile, _
"", _
userpasswd, _
NOTES_DESKTOP_CLIENT)
Dim acl As NotesACL
Dim aclEntry As NotesACLEntry
Dim dbUser As NotesDatabase
Set dbUser = New NotesDatabase(mailsvr,mailfile) ' mail/person.nsf
Set acl = dbUser.aCL
Set aclEntry = acl.Getentry( "LocalDomainAdmins" )
If Not (aclEntry Is Nothing) Then
aclEntry.UserType = ACLTYPE_PERSON_GROUP
Call acl.Save()
End if
' call name nsf and open for edit for forcing user must change password first time
Dim ndb As NotesDatabase
Dim viwUser As NotesView
Dim docUser As NotesDocument
Set ndb = New NotesDatabase( mailsvr, "names.nsf" )
Set viwUser = ndb.GetView("People by Email")
Set docUser = viwUser.GetDocumentByKey(doc.SelectMail(0),True)
Call docUser.ReplaceItemValue( "HTTPPasswordForceChange" , "1" )
Print "Force user change password is updated"
Call docUser.Save( True, True, True )
Print "Please wait ...... Registration in progress"
Call doc.Replaceitemvalue("S_Process", "Pending")
Call doc.Save(True, False)
Dim agt As NotesAgent
Set agt=db.getagent("(Welcome Mail)")
Call agt.Runonserver()
EndOfRoutine:
Exit Sub 'or exit function
ErrorHandler:
Print Err & ", " & Error & " in line " & Erl
Resume EndOfRoutine
End Sub
Function remapChr (oldString)
' to replace all special character with a empty space after that trim to remove all special character in system
Dim oldChr, newChr, newString As String
oldChr = {! "" # $ % & ' ( ) * + , - . / : ; = > ? # [ \ ] ^ _}
newChr = " {"
oldChr = Split(oldChr, " ")
newChr = Split(newChr, " ")
newString = Trim(Replace(LCase(oldString), oldChr, newChr))
remapChr = newString
End Function
Function group(groupArr, newReason$)
If IsArray(groupArr) Then
If groupArr(0) = "" Then
groupArr(0) = newReason
Else
Dim counter%
counter = UBound(groupArr) + 1
ReDim Preserve groupArr(counter)
groupArr(counter) = newReason
End If
group = groupArr
Else
Dim tempgroupArr() As String
ReDim tempgroupArr(0)
tempgroupArr(0) = newReason
group = tempgroupArr
End If
End Function
Sending mail Agent
Sub Initialize
On Error GoTo ErrorHandler
Print "Welcome Mail Agent started..."
' This agent is a sub agent for register user, which let register agent call
Dim s As New NotesSession, db As NotesDatabase, a As NotesAgent
Dim doc As NotesDocument
Set db = s.Currentdatabase
Set a = s.Currentagent
Set doc = s.Documentcontext ' uidoc
Dim maildoc As NotesDocument, body As NotesMIMEEntity
Dim stream As NotesStream
Dim receiver$
Dim tmpallve As NotesViewEntry
Dim viwUser As NotesView
Dim viwVe As NotesViewEntry
Dim viwVc As NotesViewEntryCollection
Dim docUser As NotesDocument
Set viwUser = db.GetView("(Request sort by S_Process)")
'Set docUser = viwUser.GetDocumentByKey("Pending",True)
Set viwVc = viwUser.Allentries
If viwVc.Count = 0 Then
Print "No item found in this list"
Exit Sub
End If
Set viwVe = viwVc.Getfirstentry()
Do While Not viwVe Is Nothing ' loop to all entry
Set docUser = viwVe.Document
receiver$ = docUser.SelectMail(0) + "#devsvr1.pcs.com.my"
' send mail
Set maildoc = db.Createdocument()
Call maildoc.Replaceitemvalue("Form", "Memo")
Call maildoc.Replaceitemvalue("Subject", "Welcome")
Call maildoc.Replaceitemvalue("SendTo", receiver)
Set body = maildoc.Createmimeentity
s.Convertmime = False
Set stream = s.Createstream()
stream.Writetext(|<html><body>|)
stream.Writetext(|<p>Your application for registration ....</p>|)
stream.Writetext(|<p>Welcome. Pleaase....</p>|)
stream.Writetext(|<p><em>(No signature requried on this computer generated document)</em></p>|)
stream.Writetext(|<p>*** This is a system generated email. | + _
|Please do not reply to this email. ***</p>|)
Call stream.Writetext(|</body></html>|)
Call body.Setcontentfromtext(stream, "text/html;charset=UTF-8", 1725)
Call maildoc.Send(False)
s.Convertmime = True
Call docUser.Replaceitemvalue("S_Process", "Processed")
Call docUser.Save(True, False)
Set tmpallve = viwVc.Getnextentry(viwVe)
Set viwVe = tmpallve
Loop
Print "Welcome Mail Agent finished..."
EndOfRoutine:
Exit Sub 'or exit function
ErrorHandler:
Print Err & ", " & Error & " in line " & Erl
Resume EndOfRoutine
End Sub
new update of image on 25/09/2017
(after set config router_debug=3 set config DebugRouterLookup=3 )
i try send manually will be fine...but using code directly send after registration will be fail. Not only that, i also try on sleep(2) , wait 2 second just send mail..it seem like my thought of not directly create mail account mail also not valid..not sure which part is wrong?
I suspect that your issue is one of time and caching. The Domino server maintains a Name Lookup Cache that only gets refreshed, well, occasionally (I have never figured out how occasionally that is but 5-10 minutes generally does the trick). This affects both the email functions and the web login functions. What I have done with my registration systems is have the agent that does the ID creation leave a document in it database that is in the status "Pending welcome email". Then another agent finds those docs and if they are more then 15 minutes old it attempts the email. if the email goes through then the status is changed to "Complete".
Note, you can reset the cache with the console command show nlcache reset and that almost always results in the user being able to get mail and login from a browser. But I have not been able to get that to work from a scheduled agent run on the server or a web agent.
Can you take a look at the Person Document? See if that address is properly registered on the document.
You may also try to enable router_debug=3 and DebugRouterLookUp=3 and we may see where did it try to lookup the address.

NotesReplicationEntry - Lotus Notes

I am trying to set Selective Replication using LotusScript but I cannot get it to save. The log shows no errors and the script completes without error. The replica gets created but not with my Selective Replication set.
%REM
Agent createRenewalDB
Created Dec 14, 2016 by
Description: Comments for Agent
%END REM
Option Public
Use "xxx Routines"
Sub Initialize
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim s As New NotesSession
Dim flag As Boolean
Dim renDb As NotesDatabase
Dim renFP As String
Dim renHubDb As NotesDatabase
Dim sQuote As String
Dim nowt As String
Dim pos As Long
Dim client As String
Dim frm As String
Dim L As Long
Dim P1 As String
Dim P2 As String
Dim item As NotesItem
Dim renYN As String
Dim agent As NotesAgent
Set agent = s.CurrentAgent
Print("createRenewalDB starting")
Set db = s.Currentdatabase
Set doc = db.GetDocumentByID(agent.ParameterDocID)
'Print("got doc")
client = doc.getItemValue("Client")(0)
nowt = ""
sQuote = """"
pos = 1
Dim tmp1 As String
'Print("set vars")
tmp1 = doc.getItemValue("SearchFormula")(0)
'Print("got search formula")
frm = StrLeft(StrRight(tmp1,"ix_client;"),")")
'### strip out quotation marks
Do Until pos = 0
L = Len(frm)
pos& = InStr(1,frm,sQuote)
If pos <> 0 Then
P1 = Left(frm,pos - 1) ' Part 1 of the text string
P2 = Right(frm,L- pos )
frm = P1 & nowt & P2
End If
Loop
'Print("stripped out the rubbish")
'#### Setup a new Renewals document if none exixts and Renewals has been selected
Set item = doc.getfirstitem("EnabledApps")
renYN = item.text
If InStr(renYN, "32") > 0 Then
'##### Get the Renewals Quotes Db
Set renHubDb = Get_Specific_Db_Object("Renewal Quotes", "xxx-01")
If renHubDb Is Nothing Then
MsgBox("Fail: Could not get the Renewals Quotes database on Hub, exiting renewals created.")
Exit Sub
End If
renFP = doc.getItemvalue("Renewals")(0)
'Msgbox("Renewals to be set up " + renFP)
Set renDb = s.GetDatabase("",renFP,False)
If renDb Is Nothing Then '#### No replica, so create one
Print("Creating a replica for " + client)
Set renDb = renHubDb.CreateReplica("xxx-01",renFP)
renDb.Title = client
Dim rep As NotesReplication
Dim re As NotesReplicationEntry
Dim server As String
server = "xxx-xxx-01"
Set rep = renDb.ReplicationInfo '## Get the replication info
Set re = rep.GetEntry("-",server,True) '## get the replication entry - true creates it
re.Formula = "SELECT #Contains(client;" &"""" & frm & """" & ")" '## add the selective replication
Print("selective replication formula " + re.Formula)
'## save both
Call re.Save
Call rep.Save()
Print(re.Formula) '## formula is still set correctly at this point
End If
If renDb Is Nothing Then
MsgBox("Could not create a replicate for " + client)
Exit Sub
End If
Else
MsgBox("No Renewals " + renYN)
End If
Print("###########################################Finished creating the replica - agent")
End Sub
Any thoughts?
Lotus Notes 9.0.1
Lotus Domino 9.0.1
Code is in an agent that has Full Admin Access Set on the Security Tab.
Thanks
Graeme

Getting "The linked document (UNID... cannot be found in the view (UNID ...)" Error Message

I'm getting the error message below:
Upon clicking the doclink which was being attached in the e-mail which was generated by me through clicking the send to managers button. I also tried using NotesURL instead of doclink:
Call rtitem.appendtext(emaildoc.Notesurl)
but the generated URL is different from the doclink. Below is the generated from the doclink itself.
Generated NotesURL: notes://LNCDC#PHGDC/__48257E3E00234910.nsf/0/237B2549EEA393A948257E530042BA4A?OpenDocument
Doclink: Notes://LNCDC/48257E3E00234910/28BD6697AB48F55348257E2D0006CF60/C9B0266FDC0D929E48257E530041D6F9
Can you please help? Below is my agent code.
%REM
Agent Send Email to Managers
%END REM
Option Public
Option Declare
Dim s As NotesSession
Dim db As NotesDatabase
Dim emaildoc As NotesDocument
Dim paydoc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim i As Integer
Dim view As NotesView
Sub Initialize
Set s = New NotesSession
Set db = s.CurrentDatabase
Set view = db.GetView("Pending Claims")
Dim addresses As NotesName
Dim arrpem As Variant
ReDim arrpem(0)
Set paydoc = view.GetFirstDocument
'// Store all PEM names in an array
While Not(paydoc Is Nothing)
ReDim Preserve arrpem(UBound(arrpem) + 1)
arrpem(UBound(arrpem)) = paydoc.PeopleManager(0)
Set paydoc = view.GetNextDocument(paydoc)
Wend
'// Remove all duplicate PEM names and empty entries in the array
arrpem = FullTrim(ArrayUnique (arrpem))
'// Loop the PEM names array
ForAll pem In arrpem
Set emaildoc = New NotesDocument(db)
Set addresses = New NotesName(pem)
If addresses.abbreviated <> "" Then
emaildoc.SendTo = addresses.abbreviated
emaildoc.Subject = "Leave Balances of your Direct Reports"
emaildoc.Form = "Memo"
Set rtitem = New NotesRichTextItem(emaildoc, "Body")
Call rtitem.AppendText("Dear " & addresses.common & ",")
Call rtitem.AddNewLine(2)
'// Remove paydoc value which was used in the PEM names array
Set paydoc = Nothing
'// Get all documents that has matching PEM name in the view
Dim dc As NotesDocumentCollection
Set dc = view.GetAllDocumentsByKey(addresses.Abbreviated, True)
Set paydoc = dc.GetFirstDocument
'// Append doc link of employee
While Not(paydoc Is Nothing)
Call rtitem.AppendText("Doc link of :" & paydoc.FMName(0) & " " & paydoc.LastName(0))
Call rtitem.appenddoclink(emaildoc, "Link to Leave Balance of " & paydoc.FMName(0) & " " & paydoc.LastName(0))
Call rtitem.AddNewLine(1)
Set paydoc = dc.GetNextDocument(paydoc)
Wend
'// Send email per PEM
Call emaildoc.Send(False)
End If
End ForAll
MsgBox "Emails successfully sent."
End Sub
The doclink is pointing back to the document you've created in memory for your email. When sent, that document no longer exists in the original database.
Change your code to be:
Call rtitem.appendtext(paydoc.Notesurl)

Issue with time conversion in LotusScript

I am using below code to add an appointment to the recipients calendar.
It works fine for India users. But when users from other timezone add the appointment it is not getting converted to local time.
Can any one help ?
Code below
Sub Click(Source As Button)
Dim session As New notessession
Dim workspace As New notesuiworkspace
Dim uidoc As NotesUIDocument
Dim mailDoc As notesdocument
Dim mailDB As NotesDatabase
Dim strDate As String
Dim strLocation As String
Dim strStartTime As String
Dim strEndTime As String
Dim userName As New NotesName(session.UserName)
Set uidoc=workspace.CurrentDocument
Set doc=uidoc.document
'**********Please modify this section before sending********
strTitle="Test"
strDate="11SEPTEMBER2014"
strLocation="BLR"
strStartTime="10:05"
strEndTime="10:20"
'************************************************************************
Set mailDB=session.CurrentDatabase
Set mailDoc=mailDB.CreateDocument
Set startTime=New NotesDateTime(strDate & " - " & strStartTime & " IST")
Set endTime=New NotesDateTime(strDate & " - " & strEndTime & " IST")
mailDoc.StartTimeZone="Z=-3005$DO=0$ZX=35$ZN=India"
mailDoc.EndTimeZone="Z=-3005$DO=0$ZX=35$ZN=India"
mailDoc.Form="Appointment"
mailDoc.AppointmentType="0"
mailDoc.Location=strLocation
mailDoc.Subject=strTitle
mailDoc.Principal=userName.Common
Dim currItem As NotesItem
Set currItem=mailDoc.AppendItemValue("StartDate", startTime)
Set currItem=mailDoc.AppendItemValue("StartDate", startTime)
Set currItem=mailDoc.AppendItemValue("EndDate", endTime)
Set currItem=mailDoc.AppendItemValue("StartTime", startTime)
Set currItem=mailDoc.AppendItemValue("EndTime", endTime)
Set currItem=mailDoc.AppendItemValue("StartDateTime", startTime)
Set currItem=mailDoc.AppendItemValue("EndDateTime", endTime)
Set currItem=mailDoc.AppendItemValue("CalendarDateTime", startTime)
'*********Popup for the Alarm***************
Call mailDoc.ReplaceItemValue("Alarms","1")
Call mailDoc.replaceitemvalue("$Alarm",1)
Call mailDoc.replaceitemvalue("$AlarmOffset",-120)
Call mailDoc.ReplaceItemValue("$AlarmUnit", "M")
Call mailDoc.ReplaceItemValue("$IconSwitcher", |Reminder|)
Call mailDoc.ReplaceItemValue("$AlarmMemoOptions", "")
Call mailDoc.ReplaceItemValue("dispAlarms","1")
Call mailDoc.ReplaceItemValue("dispAlarmsRd","1")
Call mailDoc.ReplaceItemValue("HideFromCalendar", "1")
'******************************End popup********
Call mailDoc.ReplaceItemValue("_ViewIcon",158)
Set currItem=doc.GetFirstItem("Body")
Call currItem.CopyItemToDocument(mailDoc,"Body")
Call mailDoc.ReplaceItemValue("SequenceNum","1")
Call mailDoc.ReplaceItemValue("$CSVersion",|2|)
Call mailDoc.ComputeWithForm(True, True)
Call mailDoc.Save(True, False)
On Error Resume Next
Set uidoc= workspace.EditDocument(True,mailDoc)
Set csEventObj= New CSCalendarEntry( 1, mailDoc, uidoc )
Call csEventObj.SetUIFlag( UI_FLAG_ALARM )
Call csEventObj.QueryClose( Continue)
Call csEventObj.QuerySave( True)
Call csEventObj.PostSave()
On Error Goto 0
''Call uidoc.Close(True)
''Dim var
''var=Messagebox("Calendar Entry added.", 0, "Mail Db")
End Sub
If you look at a meeting created manually, you'll see that StartDateTime contains a date and time, but StartDate contains just the date, and StartTime contains just the time. That's not how you've done it here, and I suspect that's your problem.
Also, use ReplaceItemValue, not AppendItemValue, to set a field. And I see you set the same field more than once (which, since you were using the wrong method, made it multivalued).

Resources