Sub AppendDocInfo(doc As NotesDocument,body As NotesRichTextItem)
On Error GoTo ErrH
Static b As Boolean
If b Then Exit Sub
b=True
Dim view As NotesView, ses As New NotesSession, db As NotesDatabase
Set db=ses.CurrentDatabase
Set view=db.GetView({REF+nameLookup})
view.AutoUpdate=False
view.Refresh
body.Update
Dim rtnav As NotesRichTextNavigator
Set rtnav = body.CreateNavigator
Dim find As Boolean, rtt As NotesRichTextTable
Set rtt=FindTable(TAG_FIRST, body, rtnav)
If rtt Is Nothing Then Error 1024, {table with text:} &TAG_FIRST & { is not found}
Dim participants, performer As String, manager As String
Dim nam As NotesName
'получаем имя инициатора
performer=doc.GetItemValue({performer})(0)
If Len(performer)<1 Then Error 1024, Chr(10) &{*Имя исполнителя не определено} &Chr(10)
'по инициатору - получаем имя менеджера
manager=PersonInfo(performer)(4)
'имена участников в согласовании
participants=doc.GetItemValue({participants})
participants=FullTrim(ArrayReplace(participants,performer,{})) 'удаляем исполнителя
Dim rows As Long, cols As Long
Dim pList List As Variant
ForAll p In participants
Dim inf
inf=PersonInfo(CStr(p))'массив из 5 элементов - первый явл. именем
If Not IsEmpty(inf) Then
If inf(0)<>manager Then
pList(inf(0))=inf
rows=rows+1
End If
End If
End ForAll
' If rows>0 Then rows=rows+1 'т.к. отсчет был от 0
cols=rtt.ColumnCount
'ищем последнюю ячейку в таблице и добавляем строки (по кол-ву подписантов)
' rtnav.FindLastElement(RTELEM_TYPE_TABLECELL)
' Call rtrange.SetBegin(rtnav)
' Print {Last Cell text:} rtrange.TextRun
rtt.AddRow(rows)
Print {Table add rows:} & CStr(rows)
body.Update
Set rtnav = body.CreateNavigator
'ставим нвигатор на первую ячейку, в добавленной строке
If Not rtnav.FindFirstString(TAG_LAST, RT_FIND_CASEINSENSITIVE) Then Error 1024,{Template last cell not found:} & TAG_LAST
rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
'по всем подписывающим персонам обрабатываем вставленные строки
ForAll info In pList
Print {info:} &Join(info,{;})
'последовательно добавляем информацию в ячейки строки
Call body.BeginInsert(rtnav)
Call body.AppendText(info(5))
Call body.EndInsert
Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
Call body.BeginInsert(rtnav)
Call body.AppendText(info(2))
Call body.EndInsert
Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
Call body.BeginInsert(rtnav)
Call body.AppendText(info(3))
Call body.EndInsert
Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
Dim entry As NotesViewEntry
'ищем подписывающее лицо (среди документов согласования)
Set entry=view.GetEntryByKey(doc.UniversalID+info(0), True)
Dim sd As String
sd={}
'sign date
If Not entry Is Nothing Then sd=CStr(entry.ColumnValues(1))
If Len(sd)>0 Then
'вставляем признак подписи - если нашли документ и он подписан
Print {Signer for } info(0) {:} entry.Document.Signer
If Len(entry.Document.Signer)>0 Then
Call body.BeginInsert(rtnav)
'Call body.AppendText(ses.CreateName(entry.Document.Signer).Common)
Call body.AppendText(CS_SIGNED)
Call body.EndInsert
Else
sd={}
End If
End If
Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
If Len(sd)>0 Then
'вставляем дату подписи
Call body.BeginInsert(rtnav)
Call body.AppendText(sd)
Call body.EndInsert
End If
Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
' Dim c As Integer
' For c=3 To cols
' Call body.BeginInsert(rtnav)
' Call body.AppendText(Cstr(c))
' Call body.EndInsert
' Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
' Next
End ForAll
'удаляем теги
Dim rtrange As NotesRichTextRange
Set rtrange=body.CreateRange
If rtnav.FindFirstString(TAG_FIRST, RT_FIND_CASEINSENSITIVE) Then
rtrange.SetBegin(rtnav)
Call rtrange.FindandReplace(TAG_FIRST,{},RT_FIND_CASEINSENSITIVE)
End If
Set rtrange=body.CreateRange 'hack for rtnav (w/o - would be error on FindAndReplace)
If rtnav.FindFirstString(TAG_LAST, RT_FIND_CASEINSENSITIVE) Then
rtrange.SetBegin(rtnav)
Call rtrange.FindandReplace(TAG_LAST,{},RT_FIND_CASEINSENSITIVE)
End If
Dim rt As NotesRichTextItem
Set rt=doc.GetFirstItem({tblAdd})
Call body.AppendRTItem(rt)
body.Update
view.AutoUpdate=True
Quit:
Exit Sub
ErrH:
Error Err, RaiseError
End Sub