Xpages + Lotusscript

Sub Click(Source As Button)
Dim session As New NotesSession
Dim view As NotesView
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim w As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim unid As String
Dim sendto As Variant
Dim success As Variant
Dim item As NotesItem
Set db = session.CurrentDatabase
Set uidoc = w.CurrentDocument
Set doc = uidoc.Document
 
AllowEdit = True
If uidoc.EditMode = False Then uidoc.EditMode = True
Call uidoc.Document.ReplaceItemValue("status","3")
Call uidoc.Document.ReplaceItemValue("state","4")
Call uidoc.Document.ReplaceItemValue("ss3","1")
Call uidoc.Document.ReplaceItemValue("ss3_date",Now())
 
answer = Msgbox ("Желаете прокоментировать?",4+32, "Вопрос:")
If answer = IDYES Then
f = w.DialogBox("DlgComment",True,True,False,True,False,False,"Комментарии:",,False,False,True)
If f Then
Call uidoc.Document.ReplaceItemValue("activity_document", Now() & " --> " & uidoc.FieldGetText("activity_user") & " : Служебная записка согласована утверждена адресатом с комментарием: " & uidoc.FieldGetText("tmpComments") & Chr(13) & uidoc.FieldGetText("activity_document"))
Call sendMail_WW(db,uidoc.Document, uidoc.Document.GetItemValue("author"),"СЗ: Ваша служебка утверждена адресатом - " + uidoc.FieldGetText("InternalNumber"),uidoc.FieldGetText("tmpComments"),"Служебную записку утвердили с коментарием")
If Not uidoc.FieldGetText("sendto_copy") ="" Then
Call sendMail_WW(db,uidoc.Document, uidoc.Document.GetItemValue("sendto_copy"),"СЗ: Утверждено адресатом (ознакомление) - " + uidoc.FieldGetText("InternalNumber"),uidoc.FieldGetText("tmpComments"),"Служебную записку утвердили с коментарием")
End If
 
Call uidoc.FieldSetText("tmpComments","")
Call uidoc.Save
Call uidoc.Document.Save(True,False)
End If
Else
 
Call uidoc.Document.ReplaceItemValue("activity_document", Now() & " --> " & uidoc.FieldGetText("activity_user") & " : Служебная записка утверждена адресатом " & Chr(13) & uidoc.FieldGetText("activity_document"))
Call uidoc.Save
Call uidoc.Document.Save(True,False)
Call sendMail_WW(db,uidoc.Document, uidoc.Document.GetItemValue("author"),"СЗ: Ваша служебка утверждена адресатом - " + uidoc.FieldGetText("InternalNumber"),Left(uidoc.FieldGetText("Body"),100),"Часть текста служебной записки")
If Not uidoc.FieldGetText("sendto_copy") ="" Then
Call sendMail_WW(db,uidoc.Document, uidoc.Document.GetItemValue("sendto_copy"),"СЗ: Утверждено адресатом (ознакомление) - " + uidoc.FieldGetText("InternalNumber"),Left(uidoc.FieldGetText("Body"),100),"Часть текста служебной записки")
End If
End If
 
If doc.Getitemvalue("SendTo_Copy")(0)<>"" Then
var = GetReaders(doc.Getitemvalue("SendTo_Copy"))
Set item = doc.ReplaceItemValue("Ot_Readers",Arrayappend(doc.ot_readers,var) )
Item.IsReaders = True
Item.IsSummary = True
Call doc.Save(True,False)
End If
 
 
Call uidoc.Save()
 
Call uidoc.Close
End Sub
 
Function GetReaders (Names As Variant)
Dim rez As Variant
Dim Persons As Variant
Dim tmpPers As Variant
 
ForAll Nam In names
tmpPers = Split(nam,"@")
rez = Evaluate(|
@Do(
Server := "Ezop";
DbName := "names.nsf";
View := "($LDAPCN)";
@Certificate([Subject];@DbLookup("":"NoCache"; Server : Dbname; View; @LowerCase(@Name([CN];"| & tmpPers(0) & |")); "Certificate")))|)
 
If IsArray(persons) Then
persons = ArrayAppend(Persons,rez)
Else
persons = rez
End If
 
End ForAll
 
GetReaders = persons
End Function
 
Sub sendMail_WW (db As NotesDatabase,doc As NotesDocument,sendto As Variant, subject As String, body As String, HeadBody As string)
Dim s As New NotesSession
Dim hdr As NotesMIMEHeader
Dim stream As NotesStream
Dim MIMEE As NotesMIMEEntity
Dim Hlink As String
Dim Nlink As String
Nlink = doc.Notesurl
 
Hlink = Replace( Nlink, "нотес адрес" , "инет адрес")
Hlink = Replace( Hlink, "notes:" , "https:")
 
 
Set mailDoc = db.CreateDocument
mailDoc.Form = "memo"
mailDoc.Principal = "Хранилище типовых документов"
mailDoc.SMTPOriginator = "Хранилище типовых документов"
mailDoc.DisplaySent = "Mail Agent"
mailDoc.From = "Внутренний документооборот"
mailDoc.Subject = subject
mailDoc.Importance = importance
mailDoc.SendTo = sendto
 
Set MIMEE = maildoc.CreateMIMEEntity("Body")
Set hdr = MIMEE.CreateHeader("MIME-Version")
Call hdr.SetHeaderValAndParams(|1.0|)
Set stream = s.CreateStream
 
Call stream.WriteText(|<p><font size="1" color="maroon" face="Tahoma">Данное сообщение является информационным. Для совершения требуемых действий
пройдите по представленным ниже ссылкам. Отвечать на данное сообщение ненужно. </p></font>|)
Call stream.WriteText(|<p><font size="2" face="Tahoma">Ссылки на документ.<br>|)
Call stream.WriteText(|<a href="| + Nlink + |">Ссылка для доступа через стандартный клиент</a><br>|)
Call stream.WriteText(|<br>|)
 
Call stream.WriteText(|<a href="| + Hlink+ |">Ссылка для доступа через WEB или с мобильного клиента</a>|)
Call stream.WriteText(|<br>|)
Call stream.WriteText(|<br>|)
 
Call stream.WriteText(||+HeadBody+|:<br>|)
Call stream.WriteText(|<br>|)
 
Call stream.WriteText(|</font><Table border="1"><Tbody><TR><TD>|)
Call stream.WriteText(Body)
Call stream.WriteText(|</TD></TR></Tbody></Table>|)
 
stream.Position = 0&
MIMEE.SetContentFromText stream, "text/html;charset=UTF-8", ENC_IDENTITY_8BIT
Call maildoc.CloseMIMEEntities(True, "MIMEE")  finalize pending changes into the document.
Call mailDoc.Send(False)
End Sub