Hi,
We have a piece of code that loops through the docuents for a meeting date and generates the minutes for a meeting.
The code adds the portfolio (if there is one) and then adds the approving minister (again, if there is one). It then goes on to add the submission number, title, and decision.
The approving minister SHOULD appear in brackets - eg (Bob Smith), even if there is no portfolio listed against the submission.
What is happening is, if there is both a portfolio and an approving minister, these details appear for each submission. However, if there isn’t a portfolio listed on a submission other than the first in the list, the approving minister only appears on the first submission and not on any subsequent submission.
Hope this makes sense - please see code below.
Cheers,
Sub LookUpSubMin (db As NotesDatabase, RecordDoc As NotesDocument, Category As String, key As String, SubNo As Integer, rtitem As NotesRichTextItem, richStyle As NotesRichTextStyle, richStyle1 As NotesRichTextStyle, richStyle2 As NotesRichTextStyle, richStyle3 As NotesRichTextStyle, richStyle4 As NotesRichTextStyle, rtpStyle As NotesRichTextParagraphStyle, sDraft As String, num As String)
’ Stan Gemlitski/Dialog 15.04.03
Dim session As New NotesSession
Dim view As NotesView
Dim dcol As NotesDocumentCollection
Dim m As Integer
Dim itemOne As NotesItem
Dim array As Variant
Dim recom As Variant
Dim plainText As String
Set view = db.GetView( "SubLookUp" )
'20071002:Additional variables declared
Dim resetcol As NotesDocumentCollection
Set dcol = view.GetAllDocumentsByKey(key, True)
'20071002:Move these lines into the affirmative block of the IF statement
%REM 02102007
Call rtitem.AppendStyle(richStyle)
Call rtitem.AppendText _
( Ucase$(Category) )
Call rtitem.AddNewLine( 1 )
%END REM
If dcol.Count > 0 Then
'=========================================
'20071002:add the “submission type heading” only if the collection contains any documents
Call rtitem.AppendStyle(richStyle)
Call rtitem.AppendText _
( Ucase$(Category) )
Call rtitem.AddNewLine( 1 )
'=========================================
'sort dcol here
array = SortDocumentCollection( dcol, "ResultSort" )
'====
Redim Preserve listN(2) As String
listN(1) = "test"
listN(2) ="test2"
Forall doc In array
Call rtitem.AppendParagraphStyle(rtpStyle)
Set itemOne = doc.GetFirstItem( "Portfolios" )
Dim listV As Variant
listV = itemOne.values
If ArraysAre (listv, listN) = True Then
Goto SubNo
End If
Dim k As Variant
k=Ubound(ListV)
Call rtitem.AppendStyle(richStyle2)
m=0
Forall v In itemOne.Values
If m=0 Then
Call rtitem.AppendText(v)
End If
If m = 1 Then
Call rtitem.AppendText("/" & v & "/")
End If
If m > 1 And m <> k Then
Call rtitem.AppendText(v & "/")
End If
If m <> 0 And m = k Then
Call rtitem.AppendText(v & " ")
End If
Redim Preserve listN(m) As String
listN(m) = v
m = m+1
End Forall
Set itemOne = doc.GetFirstItem( "ApprovingMinisters" )
m=0
Forall v In itemOne.Values
Call rtitem.AppendText("("& v &")")
m = m+1
End Forall
Call rtitem.AddNewLine( 2 )
'RTPStyle
Dim rtpStyle1 As NotesRichTextParagraphStyle
Set rtpStyle1 = session.CreateRichTextParagraphStyle
'rtpStyle1.Alignment = ALIGN_RIGHT
SubNo:
Call rtitem.AppendStyle(richStyle1)
'Append Addendums here if there are any
Dim struct As String
Dim array1 As Variant
Dim addview As NotesView
Dim b As Integer
Dim addkey As String
Dim addcol As NotesDocumentCollection
Dim searchFormula As String
Dim dateTime As New NotesDateTime("12/01/94")
Dim submission As Variant
'new
If doc.SetFlag(0) <> "Done" Then
If doc.AddendumFlag(0) = "Addendum" Then
submission = doc.AddendumParentSubmissionNumber(0)
Else
submission = doc.SubmissionNumber(0)
End If
'grab all related documents and group
addkey = submission & doc.SubmissionTitle(0) & doc.ParentDocUniqueID(0)
Set addview = db.GetView( "AddendumLookUp" )
Set addcol = addview.GetAllDocumentsByKey(addkey, True)
If addcol.Count > 0 Then
array1 = SortDocumentCollection1( addcol, "SubmissionNumber" )
b = 0
struct = ""
Forall addoc In array1
If struct = "" Then
struct = addoc.SubmissionNumber(0)
Else
struct = struct & " & " & addoc.SubmissionNumber(0)
End If
addoc.SetFlag = "Done"
Call addoc.save(True, False)
b = b + 1
End Forall
Call rtitem.AppendText _
( Str(SubNo)&". " & struct & " " & doc.SubmissionTitle(0))
End If
'attendees here if there are some
If doc.Att(0) <> "" Then
Call rtitem.AddNewLine( 2 )
Call rtitem.AddTab( 2 )
richStyle3.Bold = False
Call rtitem.AppendStyle(richStyle3)
Dim AttItem As NotesItem
Set AttItem = doc.GetFirstItem( "Att" )
Dim Att As String
Forall v In AttItem.Values
If Att = "" Then
Att = v
Else
Att = Att & ", " & v
End If
End Forall
Call rtitem.AppendText( "Attendees for this item: " & Att)
End If
’ decision section here
'Dim rtpStyle1 As NotesRichTextParagraphStyle
'Set rtpStyle1 = session.CreateRichTextParagraphStyle
’ rtpStyle1.Alignment = ALIGN_RIGHT
If doc.Decision(0) <> "" Then
Call rtitem.AddNewLine( 2 )
Call rtitem.AppendStyle(richStyle4)
’ Call rtitem.AppendParagraphStyle(rtpStyle1)
'RTPSTYLE1.Alignment = ALIGN_RIGHT
Call rtitem.AppendText("(" & doc.Decision(0) & ")")
Call rtitem.AddTab( 9 )
Call rtitem.AppendText( doc.DecisionNumber(0))
Call rtitem.AppendStyle(richStyle1)
'Call rtitem.AddNewLine( 2 )
End If
‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘‘render and remove the doc’’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’’
'Create the document in memory
Dim success As Variant
Dim unid As String
Dim docnew As NotesDocument
Set docnew = db.CreateDocument
'Set it to be a template form so we can find it later
docnew.Form = "TemplateRTForm"
'Set RTWithData = docnew.GetFirstItem( “RTWithData” )
Dim BTField As NotesRichTextItem
Set BTField = doc.GetFirstItem( "DecisionRecommendation" )
'Copy the RTField to the new template doc
Call BTField.CopyItemToDocument( docnew, "TemplateRT" )
'Save it
Call docnew.Save( True, True )
'Get the docid
unid = docnew.UniversalID
'destroy the in-memory template doc
Set docnew = Nothing
'Get it again
Set docnew = db.GetDocumentByUNID(unid)
'Render it to a RTItem
success = docnew.RenderToRTItem(rtitem)
'Destroy the template
Call docnew.Remove(True)
'==================
'Call rtitem.AddNewLine( 1 )
SubNo = SubNo + 1
If sDraft = "Draft" Then
If num <> "stop" Then
'If dcol.Count >0 Then
Call rtitem.AddPageBreak
End If
'End If
End If
End If
End Forall
Else
%REM 02102007:since you are not interested in having this text appear, we can comment it out. However, the remaining code in the ELSE block may still be valid
Call rtitem.AddNewLine( 1 )
Call rtitem.AppendText _
( “No Items”)
Call rtitem.AddNewLine( 1 )
%END REM
If sDraft = "Draft" Then
If num <> "stop" Then
'If dcol.Count >0 Then
Call rtitem.AddPageBreak
'End If
End If
End If
End If
'reset addendum here
searchFormula = "Form = ""Submission"" & SetFlag = ""Done"" "
Set resetcol = db.Search(searchFormula,dateTime,0)
If resetcol.Count > 0 Then
%REM 02102007:comment out the following code and replace with one line below
Dim j As Variant
Dim ser As NotesDocument
For j=1 To resetcol.Count
Set ser = resetcol.GetNthDocument(j)
ser.SetFlag = “Reset”
Call ser.save(True, False)
Next
%END REM
resetcol.StampAll "SetFlag", "Reset"
End If
End Sub