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 LotusScript finds the first occurrence of a string from the right Clear Recent Contacts view and prevent repopulation in Lotus Notes 8.x Search Microsoft Active Directory with LotusScript Three steps to trap and handle save conflicts with LotusScript Troubleshoot agents by displaying LotusScript variables online LotusScript sorts lists alphabetically Run or restart Notes/Domino agents via text messages LotusScript code rebuilds corrupted busytime.nsf file Soft-code item names to facilitate LotusScript management LotusScript agent automates selective mail file replication LotusScript LotusScript finds the first occurrence of a string from the right Clear Recent Contacts view and prevent repopulation in Lotus Notes 8.x Search Microsoft Active Directory with LotusScript Three steps to trap and handle save conflicts with LotusScript Troubleshoot agents by displaying LotusScript variables online LotusScript sorts lists alphabetically LotusScript code rebuilds corrupted busytime.nsf file Soft-code item names to facilitate LotusScript management LotusScript agent automates selective mail file replication LotusScript filters and attaches files to a Notes form 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.