Gather Lotus Notes information from main and response documents

Related information from SearchDomino.com: Tip: Prevent document deletion if there are response documents Expert Advice: Opening Notes documents from the CMD prompt Tutorial: 30 LotusScript tips LotusScript FAQs LotusScript Reference Center

Sub Click(Source As Button)
 Dim ws As New NotesUIWorkspace
 Dim session As New NotesSession
 Dim db As NotesDatabase
 Set db = session.CurrentDatabase
 Dim uidoc As NotesUIDocument
 Dim doc As New NotesDocument(db)
 Dim AdDoc As NotesDocument 'original"base" document
 Dim ResDoc As NotesDocument 
'all the response documents
 Dim collCount As Integer
 Dim item As NotesItem
 Dim richStyle As NotesRichTextStyle
 Call doc.ReplaceItemValue("Form", "Print Advise") 
'Output form - have a richtext field to put the table. 
In this example it is "BuiltTable"
 Dim body As New NotesRichTextItem(doc,"BuiltTable")
 Set uidoc = ws.CurrentDocument
 Set AdDoc = uidoc.Document 
 AdDoc.Workflow = "Complete"
 Set richStyle = session.CreateRichTextStyle 
 'Now copy the header information over.
 doc.SeqNum = AdDoc.SeqNum(0)
 doc.EffectiveDate = AdDoc.EffectiveDate(0)
 doc.ExpirationDate = AdDoc.ExpirationDate(0)
 Dim AdStart As New NotesDateTime("")
 Dim ResStart As New NotesDateTime("")
 Dim AdEnd As New NotesDateTime("")
 Dim ResEnd As New  NotesDateTime("")
 Set AdStart = 
AdDoc.GetFirstItem("EffectiveDate").DateTimeValue
 Set AdEnd = 
AdDoc.GetFirstItem("ExpirationDate").DateTimeValue 
 x = Ubound(AdDoc.CustomersName)
 For y = 0 To x   
  If (doc.HasItem("CustomersName")) Then
 Set item = doc.GetFirstItem("CustomersName")
 item.AppendToTextList AdDoc.CustomersName(y)
  Else
 doc.CustomersName = AdDoc.CustomersName(y)
  End If
 Next   
 x = Ubound(AdDoc.CustomersNumber)
 For y = 0 To x   
  If (doc.HasItem("CustomersNumber")) Then
 Set item = doc.GetFirstItem("CustomersNumber")
 item.AppendToTextList AdDoc.CustomersNumber(y)
  Else
doc.CustomersNumber = AdDoc.CustomersNumber(y)
  End If
 Next  
 x = Ubound(AdDoc.BillTo)
 For y = 0 To x   
  If (doc.HasItem("BillTo")) Then
   Set item = doc.GetFirstItem("BillTo")
  item.AppendToTextList AdDoc.BillTo(y)
  Else
   doc.BillTo = AdDoc.BillTo(y)
  End If
 Next   
 doc.AcctExec = AdDoc.AcctExec(0)
 doc.SalesID = AdDoc.SalesID(0) 
 'This block allows the user to select certain responses
 Dim priceType(4) As Variant
 Dim printVar  As Variant
 priceType(0) = "Alpha"
 priceType(1) = "Beta"
 priceType(2) = "Gamma"
 priceType(3) = "Delta"
 'Now, lets get the type:
 printVar = ws.Prompt(6, "Title", 
"Select the type" ,"Alpha", priceType ) 
 doc.DispFuelType = AdDoc.DispFuelType(0)
 'Now, we are going to get the collection of the response docs 
 Dim Collection As NotesDocumentCollection
 Set Collection = AdDoc.Responses
 collCount = Collection.Count
 rowCount% = collCount 
 columnCount% = 8 
 richStyle.FontSize = 8
 Dim tableColStyles(1 To 8) 
As NotesRichTextParagraphStyle 'loop through this 
once for each column
 For i = 1 To columnCount% Step 1
Set tableColStyles(i) = session.CreateRichTextParagraphStyle 
' Create the rt paragraph style for this column
tableColStyles(i).FirstLineLeftMargin = 0 
' Set left margin for the first line of each cell in column
tableColStyles(i).LeftMargin = 0 
' Set left margin for all but the first line of 
each cell in column
tableColStyles(i).RightMargin = RULER_ONE_INCH * 1
tableColStyles(i).Alignment = ALIGN_CENTER 
' Centre the 2nd column. This is just to show that you can :
Set styles = session.CreateRichTextParagraphStyle
styles.Alignment = ALIGN_CENTER
Next
Call body.AppendTable( 1, columnCount%,,, tableColStyles) 
'1 row to start, rest will be added as needed.
'Now populate the table 
Dim rtnav As NotesRichTextNavigator
 Set rtnav = body.CreateNavigator
 rtnav.FindFirstElement(RTELEM_TYPE_TABLE)
 Dim rtt As NotesRichTextTable
 Set rtt = rtnav.GetElement
 Call rtnav.FindFirstElement(RTELEM_TYPE_TABLECELL)  '1
 Call body.AppendParagraphStyle(styles)  
 'The first row is the headers
 Call body.BeginInsert(rtnav)
 Call body.AppendText("From")
 Call body.EndInsert
 Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL) '2 
 Call body.BeginInsert(rtnav)
 Call body.AppendText("To")
 Call body.EndInsert
 Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL) '3 
 Call body.BeginInsert(rtnav)
 Call body.AppendText("Per Mile")
 Call body.EndInsert
 Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL) ' 4
 Call body.BeginInsert(rtnav)
 Call body.AppendText("Flat Rate/Minimum")
 Call body.EndInsert
 Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL) '5
 Call body.BeginInsert(rtnav)
 Call body.AppendText("Effective Date")
 Call body.EndInsert
 Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL) '6
 Call body.BeginInsert(rtnav)
 Call body.AppendText("Expiration Date")
 Call body.EndInsert
 Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL) '7
 Call body.BeginInsert(rtnav)
 Call body.AppendText("Rate Type")
 Call body.EndInsert
 Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL) '8
 Call body.BeginInsert(rtnav)
 Call body.AppendText("Mode")
 Call body.EndInsert
 Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
 'next row
 'Now add in data from the response documents selected
 For iRow = 1 To rowCount% Step 1
Set ResDoc = Collection.GetNthDocument(Cint(iRow))
If (printVar = "All" Or printVar = ResDoc.RowType(0)) Then 
Call rtt.AddRow(1) 
Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL) 
Call body.BeginInsert(rtnav)
'if has city
If Not (ResDoc.CityFrom(0) = "") Then                       '1
Call body.AppendText(ResDoc.CityFrom(0) & ", " )
 Call body.AppendText(ResDoc.StateFrom(0))   
 If Not (ResDoc.ZIPFrom(0) = "") Then
 Call body.AppendText(" " & ResDoc.ZipFrom(0))
  End If
   Else 
Call body.AppendText(ResDoc.StateFrom(0))
Call body.AppendText(ResDoc.ZipFrom(0))  
   End If
 'Otherwise it's a state or Zip  
 Call body.EndInsert
 Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)  '2
 Call body.BeginInsert(rtnav)  
 If Not(ResDoc.CityTo(0) = "") Then
 Call body.AppendText(ResDoc.CityTo(0) & ", " )
 Call body.AppendText(ResDoc.StateTo(0))
 If Not(ResDoc.ZIPTo(0) = "") Then
 Call body.AppendText(" " & ResDoc.ZipTo(0))
 End If
  Else   
 Call body.AppendText(ResDoc.StateTo(0))
 Call body.AppendText(ResDoc.ZipTo(0))
 End If  
 Call body.EndInsert
 Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)  
  '3 
 Call body.BeginInsert(rtnav)
 If Not (Cstr(ResDoc.PerMile(0)) = "") Then
 Call body.AppendText(Format(ResDoc.PerMile(0),"Currency"))
 End If  
 Call body.EndInsert
 Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)  '4 
 Call body.BeginInsert(rtnav)
 If Not (Cstr(ResDoc.Flat(0)) = "") Then
 Call body.AppendText(Format(ResDoc.Flat(0),"Currency"))
 End If
 Call body.EndInsert
 Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)  '5  
 Call body.BeginInsert(rtnav)
 If Not (Cstr(ResDoc.RowStart(0)) = "") Then
 'see if this matches the Start date of the advisement   
 Set ResStart = ResDoc.GetFirstItem("RowStart").DateTimeValue
 Call ResStart.SetAnyTime
 If Not (AdStart.DateOnly = ResStart.DateOnly) Then
 Call body.AppendText(Format(ResDoc.RowStart(0),"mm/dd/yyyy"))
 End If
End If
Call body.EndInsert
Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)  '6  
Call body.BeginInsert(rtnav)
If Not (Cstr(ResDoc.RowEnd(0)) = "") Then
Set ResEnd = ResDoc.GetFirstItem("RowEnd").DateTimeValue
Call ResEnd.SetAnyTime
If Not (AdEnd.DateOnly = ResEnd.DateOnly) Then
Call body.AppendText(Format(ResDoc.RowEnd(0),"mm/dd/yyyy"))
 End If
End If
Call body.EndInsert
Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)  '7   
Call body.BeginInsert(rtnav)
Call body.AppendText(ResDoc.Rowtype(0))
Call body.EndInsert
Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL) '8
Call body.BeginInsert(rtnav)
Call body.AppendText(ResDoc.SvcType(0))
Call body.EndInsert
Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL) 'next row
 End If
 Next 
 If AdDoc.HasItem("AdFuelSurcharge") Then
 Set item = AdDoc.GetFirstItem("AdFuelSurcharge")
 Call item.CopyItemToDocument(doc,"AdFuelSurcharge")
 End If
 doc.AdComments = AdDoc.AdComments(0) 
 Call doc.Save(True,False)
 Call  ws.ViewRefresh
 'Now get the just created doc and view in the UI
 Dim univID As String
 Dim newuiDoc As NotesUIDocument
 univDI = doc.UniversalID 
 Set newuiDoc = ws.EditDocument(False, doc) 
End Sub

Do you have comments on this tip? Let us know.

This tip was submitted to the SearchDomino.com tip library by member Brian Moore. Please let others know how useful it is via the rating scale below. Do you have a useful Lotus Notes, Domino, Workplace or WebSphere tip or code snippet to share? Submit it to our monthly tip contest and you could win a prize.

Rate this Tip To rate tips, you must be a member of SearchDomino.com. Register now to start rating these tips. Log in if you are already a member. Digg This!     StumbleUpon     Del.icio.us    RELATED CONTENT LotusScript Display a custom message box using a LotusScript-generated button Can I use LotusScript to merge cells in a Microsoft Word table? Debug Lotus Notes documents using extracted data Extracting attachments from a Lotus Notes rich-text field Programmatically replace the design of Lotus Notes databases Reading a binary field in an Oracle database with LotusScript LotusScript equivalent of @Picklist for Lotus Notes Launch large attachments within an email from a Notes database How to find files on a hard drive or mapped network with LotusScript Update the ACL from the Roles view with LotusScript LotusScript Display a custom message box using a LotusScript-generated button Debug Lotus Notes documents using extracted data Extracting attachments from a Lotus Notes rich-text field Programmatically replace the design of Lotus Notes databases Reading a binary field in an Oracle database with LotusScript LotusScript equivalent of @Picklist for Lotus Notes Launch large attachments within an email from a Notes database How to find files on a hard drive or mapped network with LotusScript Update the ACL from the Roles view with LotusScript LotusScript agent moves tagged spam email to junk mail folder RELATED RESOURCES 2020software.com, trial software downloads for accounting software, ERP software, CRM software and business software systems Search Bitpipe.com for the latest white papers and business webcasts Whatis.com, the online computer dictionary DISCLAIMER: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.