Extract the current web document to Excel

The agent below extracts the current active web page data to excel. There's a subfunction inserted in the code below to parse out a long comments field to 130 characters per line over multiple varying lines to maintain the table on one page.
HTML • LotusScript


Sub Initialize
	
	Dim session As New NotesSession
	Dim db As NotesDatabase
	Set db = session.CurrentDatabase
	Dim doc As NotesDocument
	Set doc = session.DocumentContext
	
	'******************** Spacer ***************************************
	'THIS UNDERSCORE SPACER IS CRUTIAL TO KEEP THE SPACING FULL PAGE AND ALLOW THE ON/OFF TOGGLE OF BORDERS
	Dim spacer As String
	spacer = "____________________________________________________________________________________"
	
	'******************** Header Details*******************************
	Dim EmployeeName As String
	If Trim(doc.EmployeeName(0)) = "" Then
		EmployeeName = "Generic"
	Else
		EmployeeName  = doc.EmployeeName(0) 
	End If
	
	'Create excel spreadsheet
	Print |Content-Type:application/vnd.ms-excel|
	
	Print |<table border = "0" width="630">|
	
	Print "<tr>" &_
	"<td colspan='6'><B><p align='center'>Cost Projection Summary Report</p></B></td>" &_
	"</tr>"	
	
	Print "<tr>" &_
	"<td colspan='6'><p align='center'>Employee Name: " & EmployeeName & "</p></td>" &_
	"</tr>"	
	
	Print "<tr>" &_
	"<td colspan='6'><p align='center'>Projection Name: " & doc.ProjectionTitle(0) & "</p></td>" &_
	"</tr>"	
	
	'*************************************************************************************
	'THIS UNDERSCORE SPACER IS CRUTIAL TO KEEP THE SPACING FULL PAGE AND ALLOW THE ON/OFF TOGGLE OF BORDERS
	Print "<tr><td colspan='6' NOWRAP><p align='center'>" & spacer & "</p></td></tr>"
	Print |<tr><td colspan='6' NOWRAP><p align='center'></p></td></tr>|	
	
	'************ Location Details*******************************************************
	Dim Criteria01, Criteria02, Criteria03, Criteria04, Criteria05, Criteria06, Criteria07, Criteria08, Criteria09 As String
	If doc.Criteria01Name(0)<>"" Then Criteria01 = doc.Criteria01Name(0) & ": " & doc.Criteria01(0)
	If doc.Criteria02Name(0)<>"" Then Criteria02 = doc.Criteria02Name(0) & ": " & doc.Criteria02(0)
	If doc.Criteria03Name(0)<>"" Then Criteria03 = doc.Criteria03Name(0) & ": " & doc.Criteria03(0)
	If doc.Criteria04Name(0)<>"" Then Criteria04 = doc.Criteria04Name(0) & ": " & doc.Criteria04(0)
	If doc.Criteria05Name(0)<>"" Then Criteria05 = doc.Criteria05Name(0) & ": " & doc.Criteria05(0)
	If doc.Criteria06Name(0)<>"" Then Criteria06 = doc.Criteria06Name(0) & ": " & doc.Criteria06(0)
	If doc.Criteria07Name(0)<>"" Then Criteria07 = doc.Criteria07Name(0) & ": " & doc.Criteria07(0)
	If doc.Criteria08Name(0)<>"" Then Criteria08 = doc.Criteria08Name(0) & ": " & doc.Criteria08(0)
	If doc.Criteria09Name(0)<>"" Then Criteria09 = doc.Criteria09Name(0) & ": " & doc.Criteria09(0)
	
	If Criteria01 <> "" Then
		Print "<tr>" &_
		"<td colspan='3'><p align='center'></p>" & Criteria01 & "</td>" &_
		"<td colspan='3'><p align='center'></p>" & Criteria02 & "</td>" &_
		"</tr>"
	End If
	
	If Criteria03 <> "" Then
		Print "<tr>" &_
		"<td colspan="3"><p align='center'></p>" & Criteria03 & "</td>" &_
		"<td colspan="3"><p align='center'></p>" & Criteria04 & "</td>" &_
		"</tr>"
	End If
	
	If Criteria05 <> "" Then
		Print "<tr>" &_
		"<td colspan="3"><p align='center'></p>" & Criteria05 & "</td>" &_
		"<td colspan="3"><p align='center'></p>" & Criteria06 & "</td>" &_
		"</tr>"
	End If
	
	If Criteria07 <> "" Then
		Print "<tr>" &_
		"<td colspan="3"><p align='center'></p>" & Criteria07 & "</td>" &_
		"<td colspan="3"><p align='center'></p>" & Criteria08 & "</td>" &_
		"</tr>"
	End If
	
	If Criteria09 <> "" Then
		Print "<tr>" &_
		"<td colspan="3"><p align='center'></p>" & Criteria09 & "</td>" &_
		"<td colspan="3"><p align='center'></p></td>" &_
		"</tr>"
	End If
	
	'********************************************************************************************
	
	'THIS UNDERSCORE SPACER IS CRUTIAL TO KEEP THE SPACING FULL PAGE AND ALLOW THE ON/OFF TOGGLE OF BORDERS
	Print "<tr><td colspan='6' NOWRAP><p align='center'>" & spacer & "</p></td></tr>"
	Print |<tr><td colspan='6' NOWRAP><p align='center'></p></td></tr>|	
	
	'*************************** Table Details*************************************************
	
	Print "<tr>" &_
	"<td><B><p align='center'></p></B></td>" &_
	"<td><B><p align='center'></p></B></td>" &_
	"<td><B><p align='center'>Year 1</p></B></td>" &_
	"<td><B><p align='center'>Year 2</p></B></td>" &_
	"<td><B><p align='center'>Year 3</p></B></td>" &_
	"<td><B><p align='center'>SubTotal</p></B></td>" &_
	"</tr>"	
	
	Dim Header As Variant
	Dim Accounts As Variant
	Dim Year1 As Variant
	Dim Year2 As Variant
	Dim Year3 As Variant 
	Dim SubTotal As Variant
	Dim Year1Total As Variant
	Dim Year2Total As Variant
	Dim Year3Total As Variant
	Dim Total As Variant
	
	For s = 1 To 5
		Header = doc.GetItemValue("Section" & s & "Header")
		If Header(0) <> "" Then
			Accounts = doc.GetItemValue("Section" & s & "Accounts")
			Year1 = doc.GetItemValue("Section" & s & "Year1")
			Year2 = doc.GetItemValue("Section" & s & "Year2")
			Year3 = doc.GetItemValue("Section" & s & "Year3")
			SubTotal = doc.GetItemValue("Section" & s & "SubTotal")
			Year1Total = doc.GetItemValue("Sec" & s & "Yr1Total")
			Year2Total = doc.GetItemValue("Sec" & s & "Yr2Total")
			Year3Total = doc.GetItemValue("Sec" & s & "Yr3Total")
			Total = doc.GetItemValue("Section" & s & "Total")
			
			Print "<tr>" & _
			"<td colspan="6"><B><p align='left'></p>" & header(0) & "</B></td>" & _
			"</tr>"	
			
			Print |<table border = "1">|
			
			Redim Preserve Year1(Ubound(Accounts))
			Redim Preserve Year2(Ubound(Accounts))
			Redim Preserve Year3(Ubound(Accounts))
			Redim Preserve SubTotal(Ubound(Accounts))
			
			For d = 0 To Ubound(Accounts)	
				Print "<tr>" & _
				"<td colspan="2"><p align='center'></p>" & Accounts(d) & "</td>" & _
				"<td style='vnd.ms-excel.numberformat:#,##0.00_)[semicolon][Red](#,##0.00)'>" & Year1(d) & "</td>" & _
				"<td style='vnd.ms-excel.numberformat:#,##0.00_)[semicolon][Red](#,##0.00)'>" & Year2(d) & "</td>" & _
				"<td style='vnd.ms-excel.numberformat:#,##0.00_)[semicolon][Red](#,##0.00)'>" & Year3(d) & "</td>" & _
				"<td style='vnd.ms-excel.numberformat:#,##0.00_)[semicolon][Red](#,##0.00)'>" & SubTotal(d) & "</td>" & _   
				"</tr>"	
			Next d
			
			Print "<tr>" & _
			"<td colspan="2"><B><p align='right'>Total</p></B></td>" &_
			"<td style='vnd.ms-excel.numberformat:#,##0.00_)[semicolon][Red](#,##0.00)'><B>" & Year1Total(0) & "</B></td>" & _
			"<td style='vnd.ms-excel.numberformat:#,##0.00_)[semicolon][Red](#,##0.00)'><B>" & Year2Total(0) & "</B></td>" & _
			"<td style='vnd.ms-excel.numberformat:#,##0.00_)[semicolon][Red](#,##0.00)'><B>" & Year3Total(0) & "</B></td>" & _
			"<td style='vnd.ms-excel.numberformat:#,##0.00_)[semicolon][Red](#,##0.00)'><B>" & Total(0) & "</B></td>" & _
			"</tr>"	
			
			Print |<table border = "0">|
			
			Print "<tr>" & _
			"<td colspan="6"><p align='center'></p></td>" & _
			"</tr>"	
			
		End If
		
	Next s
	
	'****************************************************************************
	
	Print |<table border = "0">|
	
	'****************** Assumptions Details***********************************
	
	Print "<tr>" & _
	"<td colspan="6"><B><p align='left'></p>Assumptions</B></td>" & _
	"</tr>"	
	
	'%%%%%%%%%%% Begin the comments field row extraction %%%%%%%%%%%%%%%%%
	Dim z As Long
	Dim Comments() As String
	Redim Comments(z) As String
	Dim increment As Long
	
	'###########
	Increment = 130
	'###########
	
	Dim Section As String
	Dim RLetter As String
	Dim StartIndex As Long
	StartIndex = 1
	Dim EndIndex As Long
	EndIndex = Increment	
	
	Dim ubnd As Long
	ubnd = Len ( doc.comments(0) )
	
	Do
		Section = Mid$( doc.comments(0) , StartIndex, EndIndex )
		RLetter = Right (Section, 1)
		
		If RLetter = " " Then
			'write
			Print "<tr><td colspan="6"><FONT SIZE=1 FACE="Arial">" & Section & "</Font></td></tr>"	
			StartIndex = StartIndex + EndIndex
			EndIndex = Increment
'			Print section
		Else
		'backspace on character
			EndIndex = EndIndex - 1
		End If
	Loop Until StartIndex >= (ubnd - Increment)
	
	'Extract the tex for the remainder of the field which is less than the current increment
	EndIndex = (ubnd - StartIndex) + 1
	Section = Mid$( doc.comments(0) , StartIndex, EndIndex )
	Print "<tr><td colspan="6"><FONT SIZE=1 FACE="Arial">" & Section & "</Font></td></tr>"
	
	'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%
	
	'************************************************************************
	
	Print |<tr><td colspan='6'><p align='center'></p></td></tr>|	
	
	'******************* Footer Details*************************************
	
	Print "<tr>" &_
	"<td colspan="3"><p align='left'></p>Prepared By: " & doc.PreparedBy(0) & "</td>" &_
	"<td colspan="3"><p align='left'></p>Prepared For: " & doc.Company(0) & "</td>" &_
	"</tr>"
	
	'***********************************************************************
	
	'Closes the table
	Print |</table>|
	
End Sub

Posted by fbrefere001 on Thursday June 24, 2004