%REM
Class createTable
Description: Comments for Class
%END REM
Class TableDXL
Private s As NotesSession
Private db As NotesDatabase
Private doc As NotesDocument
Sub New(doc_ As NotesDocument)
On Error GoTo errorProc
Set Me.s=New NotesSession()
Set Me.db=Me.s.Currentdatabase
Set Me.doc=doc_
endofsub:
Exit Sub
errorproc:
MsgBox "Error #" & Err & " on line " & Erl
Resume endofsub
End Sub
Function createHotSpot (nameHotSpot As String, ScriptCode As String) As String
Dim hotSpot As String
hotspot = |
<par>
<run><font style='underline' color='blue'/></run>
<actionhotspot hotspotstyle='none'><run><font style='underline' color='blue'/>|& nameHotSpot &|
</run>
<code event='click'>
<lotusscript>
Sub Click(Source As Button)
| & ScriptCode & |
end sub
</lotusscript>
</code>
</actionhotspot>
</par>
|
createHotSpot = hotspot
End Function
Function appendTable(docCol As NotesDocumentCollection, sType As String, rt As NotesRichTextItem) As NotesDocument
On Error GoTo ErrorHandler
Dim tmpNoteID As String
Dim newdoc As NotesDocument
Dim stream As NotesStream
Dim dmp As NotesDXLImporter
Dim i As Long
i = 1
Dim firstDoc As NotesDocument
Dim tempDoc As NotesDocument
Dim Script As String
Dim mainDoc As NotesDocument
Dim newTableRow As String
Dim SearchDB As String
Dim SearchDBView As String
Dim dbS As NotesDatabase
Dim ResArr() As String
ReDim resArr(0)
Select Case docCol.Parent.Filename
Case "etc_tbs.nsf":
SearchDB = "OSV"
Set dbS = GetCurrentDb (SearchDB, "")
Case "etccontent.nsf":
SearchDB = "contentmanager"
Set dbS = GetCurrentDb (SearchDB, "")
Case "var.nsf":
SearchDB = "VAR"
Set dbS = GetCurrentDb (SearchDB, "")
Case "etcdocflow.nsf"
SearchDB = "etcdocflow"
Set dbS = GetCurrentDb (SearchDB, "")
End Select
newTable = |
<table rightmargin="30%">
<border style="solid" Width="0px" color="black" />
<tablecolumn Width="50%"/><tablecolumn /><tablecolumn Width="32%"/>
<tablerow>
<tablecell bgcolor="#C0C0C0"><par>Ссылка на документ</par></tablecell>
<tablecell bgcolor="#C0C0C0"><par>Переход в представление по документу</par></tablecell>
<tablecell bgcolor="#C0C0C0"><par>Столбци поиска</par></tablecell>
</tablerow>|
Set firstDoc=docCol.GetFirstDocument
While Not (firstDoc Is Nothing)
Set tempDoc = docCol.GetNextDocument(firstdoc)
If resArr(0) = "" Then
resArr(0) = firstDoc.UniversalID
Else
ReDim Preserve resArr(UBound(ResArr) + 1)
resArr(UBound(ResArr)) = firstDoc.UniversalID
End If
Select Case sType
Case "Requirement","CardPD":
Set mainDoc = GetMainDoc(firstDoc)
If Not mainDoc Is Nothing then
If GetMainDoc(firstDoc).Getitemvalue("Form")( 0 ) = "Requirement" Then
SearchDBView = "RequirementByBusinessUnit"
Else
SearchDBView = "TaxPacketByBusinessUnit"
End If
End If
Case "TaxPackage":
SearchDBView = "TaxPacketByBusinessUnit"
Case "NAR","PD","Dog":
SearchDBView = "NAR"
Case "In":
SearchDBView = "InByStatusNew"
Case "Out":
SearchDBView = "OutByStatus"
Case "Task":
SearchDBView = "TaskWithChangedExecutor"
Case "DocFlowNAR":
SearchDBView = "NARALL"
Case "TaxPack":
SearchDBView = "TaxPackByStatus"
Case "OSV":
SearchDBView = "OSVStatus"
End Select
Script = |
on error goto ErrorHandler
unid = "| & Trim(firstDoc.Universalid) & |"
Dim db As NotesDatabase
Dim view As NotesView
Dim mDoc As NotesDocument
Set db = GetCurrentDb ("|& SearchDB &|", "")
Set mDoc = db.getDocumentByUnid(unid)
Set view = db.GetView("|& SearchDBView &|")
If Not view Is Nothing Then
If Not mDoc Is Nothing Then
Call wsGL.Opendatabase(db.Server, db.FilePath, view.Aliases(0))
Call wsGL.Currentview.Selectdocument(mDoc)
End If
End If
endsub:
Exit sub
ErrorHandler:
MsgBox {ошибка на.. >> Error } + Error + { on } + Erl
Resume endsub
|
If i >254 Then
i = 1
tableRow = tableRow & |</table>
<table rightmargin="30%">
<border style="solid" width="0px" color="black" />
<tablecolumn width="50%"/><tablecolumn /><tablecolumn width="32%"/>
<tablerow>
<tablecell bgcolor="#C0C0C0"><par>Ссылка на документ</par></tablecell>
<tablecell bgcolor="#C0C0C0"><par>Переход в представление по документу</par></tablecell>
<tablecell bgcolor="#C0C0C0"><par>Столбци поиска</par></tablecell>
</tablerow> |
Else
tableRow = tableRow & Chr(10)& |
<tablerow>
<tablecell><pardef id = "|& i &|" align="center" /><par><doclink document='|& CStr(Trim(firstDoc.Universalid)) &|' database='|& CStr(Trim(dbS.replicaID)) &|' description='Ссылка на документ'/></par></tablecell>
<tablecell>|& createHotSpot("Перейти" , Script) &|</tablecell>
<tablecell><par>|& UBound(resArr)+ 1 &|</par></tablecell>
</tablerow>|
End If
Set firstDoc=tempDoc
i = i + 1
Wend
Set stream = s.CreateStream
stream.WriteText |<?xml version='1.0' encoding='utf-8' ?>
<database xmlns='http://www.lotus.com/dxl' version='8.5.3'>
<document form='Form'>
<item name='Subject'><text>DXL table</text></item>
<item name='Body'>
<richtext>
<table rightmargin="30%">
<border style="solid" width="0px" color="black" />
<tablecolumn width="50%"/><tablecolumn /><tablecolumn width="32%"/>
<tablerow>
<tablecell bgcolor="#C0C0C0"><par>Ссылка на документ</par></tablecell>
<tablecell bgcolor="#C0C0C0"><par>Переход в представление по документу</par></tablecell>
<tablecell bgcolor="#C0C0C0"><par>Столбци поиска</par></tablecell>
</tablerow> | & tableRow & |
</table>
</richtext>
</item>
</document>
</database> |
' Import new document with button into current database
Set dmp = s.CreateDXLImporter(stream, me.db)
dmp.DocumentImportOption = DXLIMPORTOPTION_CREATE
dmp.Process
' Get the NoteID of the newly created document
tmpNoteID = dmp.GetFirstImportedNoteID()
' Get the document by the NoteID and return it
Set newdoc = me.db.GetDocumentByID(tmpNoteID)
Call docgl.Replaceitemvalue("Count",UBound(resArr)+ 1)
Call docGL.ReplaceItemValue("ResultUNIDList", resArr)
Call rt.AppendRTItem(newdoc.GetFirstItem("Body"))
Set appendTable = newdoc
endsub:
Exit Function
ErrorHandler:
MsgBox "appendTable ошибка на.. >> Error " & Error & " on " & Erl
Resume endsub
End Function
End Class
