38. 面向对象的LotusScript（十）之导出Excel（二）

我们来看看作为基类的Report的代码：

Public Const REPORT_TYPE_TABLE=0 'A table style report, write to a new sheet
Public Const REPORT_TYPE_TEMPLATE=1 'Write to a Excel template with formats
Public Class Report
	Private reportType As Integer 
	Private template As String 'Template name in the case of REPORT_TYPE_TEMPLATE
	Private VIEW_TEMPLATE As String 'Name of the view storing templates
	'Notes variables
	Private session As NotesSession
	Private db As NotesDatabase
	Private ws As NotesUIWorkspace	
	Private viewExport As NotesView
	
	'Excel relevant variables
	Public Save As Boolean
	Private xlFileName As String
	Private xlApp As Variant
	Private xlWork As Variant
	Private xlSheet As Variant
	Private writer As SheetWriter
	
	Sub New()
		me.reportType=REPORT_TYPE_TABLE
		me.VIEW_TEMPLATE="vwExcelTemplate"		
		me.xlFileName = ""
		
		Set session = New NotesSession
		Set db = session.CurrentDatabase		
		Set ws=New NotesUIWorkspace			
	End Sub
	
	'创建 Excel.Application 对象
	Private Function CreateExcelObject() As Integer
		CreateExcelObject = False
		
		If me.reportType=REPORT_TYPE_TABLE And me.Save Then
			If xlFileName = "" Then
				Dim result As Variant
				result=ws.Savefiledialog(False, "Lotus Notes", "Excel workbook|*.xlsx|Excel 97-2003 workbook|*.xls")
				If IsEmpty(result) Then Exit Function
				me.xlFileName=result(0)
			End If
		End If
		
		Set xlApp = CreateObject("Excel.Application")
		If xlApp Is Nothing Then
			'Error 6503,"创建 Excel.Application 对象失败，请确认是否安装Excel 。"
			Error 6503, "Failed to create an Excel object. Check if Excel is installed."
		End If
		
		xlApp.Visible = False 
		If me.reportType=REPORT_TYPE_TABLE then
			Set xlWork = xlApp.Workbooks.Add
		Else
			Set xlWork=xlApp.Workbooks.Open(me.xlFileName)
		End If
		
		xlApp.referenceStyle = 2
		Set xlSheet = xlApp.Workbooks(1).Worksheets(1)
		Set writer=New SheetWriter(me.xlSheet)
		
		If me.Save Then
			Call xlWork.SaveAs( xlFilename )
		End If 
		
		CreateExcelObject = True
		Exit Function
	End Function
	
	%REM
		Function ExtractTemplate
		Description: Comments for Function
	%END REM
	Private Function ExtractTemplate() As Boolean
		ExtractTemplate=False 
		Dim doc As NotesDocument
		Set doc=GetDocByKey(me.VIEW_TEMPLATE, me.template)
		If doc Is Nothing Then
			Exit Function 
		End If
		'The template is stored in the 'Template' item
		Dim rtItem As NotesRichTextItem
		Set rtItem=doc.GetFirstItem("Template") 		
		Dim eo As NotesEmbeddedObject
		Set eo=rtItem.Embeddedobjects(0)
		If eo Is Nothing Then
			Exit Function 
		End If
		
		Dim temp As String
		temp=Environ("TEMP")
		Dim path As String
		randomize
		path=temp & "\" & Rnd() & eo.Name
		
		Call eo.Extractfile(path)
		
		me.xlFileName=path
		ExtractTemplate=True
	End Function
	
	Public Function Export() As Integer
		Export = False
		
		If me.reportType=REPORT_TYPE_TEMPLATE Then
			If Not me.ExtractTemplate() Then
				Exit Function 
			End If
		End If
		
		If Not CreateExcelObject() Then Exit Function
		
		If me.reportType=REPORT_TYPE_TABLE Then
			Call ExportTitle()     '把视图标题行导出到Excel文件的第一行
		End If
		
		Call ExportData()    '开始导出数据
		
		If me.Save Then
			Call xlWork.Save()
			Call xlApp.Quit()
			MsgBox "A report is successfully saved to " & xlFileName & "."
		Else
			me.xlApp.Visible=True 
		End If
		
		Export = True
	End Function
	
	%REM
		If the report type is TABLE, write the first line of the worksheet as column headers.
		To be overloaded in sub classes. 
	%END REM
	Private Function ExportTitle

	End Function
	
	'Write in the worksheet, to be overloaded in sub classes. 
	Private Function ExportData()
		
	End Function 

End Class

这个类做的包括创建和销毁Excel对象，读取配置好的Excel模板，实现公共的Export()方法和定义两个私有的空方法接口。

下面是一个实现表格型报表的实例：

Public Class LiaisonReport As ExpReport
	'internal variables
	Private intYear As Integer
	Private intMonth As Integer

	Private otherCols As NArray
	Private nav As NotesViewNavigator
	Sub New(selYear As Integer, selMonth As Integer)
		me.intYear=selYear
		me.intMonth=selMonth
		Set viewExport=db.Getview("vhLiaisonForm")
		Set otherCols=New NArray(-1)
		With otherCols
			Call .Add("Month")
			Call .Add("Day")
			Call .Add("Year")
			Call .Add("Description")
			Call .Add("Nature")
			Call .Add("Nature Desc.")
			Call .Add("Amount")
			Call .Add("Source")
			Call .Add("Type")
			Call .Add("Chart of account")
			Call .Add("Expense account")
			Call .Add("No")
			Call .Add("Pay from")
			Call .Add("Office")
			Call .Add("Unit")
			Call .Add("Check No.")			
		End With
		
		Dim v As Variant
		v=accountInfos.GetList()
	End Sub
	
	Private Function ExportData
		Dim entryCol As NotesViewEntryCollection
		Dim entry As NotesViewEntry
		Dim detailDc As NotesDocumentCollection
		Dim detailDoc As NotesDocument
		Dim keys(1) As Integer
		keys(0)=me.intYear
		keys(1)=me.intMonth
		Set nav=me.viewExport.Createviewnavfromcategory(CStr(intYear)&"-"&Cstr(intMonth))
		Set entry=nav.Getfirst()
		Do Until entry Is Nothing 
			Call me.WriteCols(entry)
			Call writer.NextRow()
			Set entry=nav.Getnextcategory(entry)
		Loop
	End Function
	
	Private Function ExportTitle()
		Dim cols As Variant
		Dim i As Integer 
		cols=me.otherCols.container
		For i=0 To UBound(cols)
			writer.WriteCell(cols(i))
		Next
		
		Call writer.NextRow()
		
	End Function
	
	%REM
		Description: Comments for Function
	%END REM
	Private Function WriteCols(entry As NotesViewEntry)
		Dim amount As Double
		amount=entry.Columnvalues(4)
		Set entry=nav.Getchild(entry)
		Dim doc As NotesDocument
		Set doc=entry.Document
		Dim ed As New ExtDoc(doc)
		'Calculate the "expense office" used to get office code
		Dim office As String
		office=doc.Getitemvalue("Office")(0)		
		Dim payFrom As String
		payFrom=doc.Getitemvalue("expPayfrom")(0)
		Dim ctg As String
		ctg=GetValueByKey("vwPaymentSource", payFrom, "Category", "") 
		Dim expOffice As String 
		If ctg="Bank" Then
			expOffice=GetValueByKey("vwPaymentSource", payFrom, "Office", "")
		Else
			expOffice=office
		End If		
		Dim code As String
		code=GetValueByKey("vwOffice", expOffice, 1, "")
		'Month
		writer.WriteCell(Month(doc.Getitemvalue("PLYM")(0)))
		'Day
		writer.WriteCell(Day(doc.Getitemvalue("PLYM")(0)))
		'Year
		writer.WriteCell(Year(doc.Getitemvalue("PLYM")(0)))
		'Description
		writer.WriteCell(doc.Getitemvalue("Title")(0))
		'Nature
		Dim account As String
		Dim nature As String 
		Dim ai As AccountInfo
		account=doc.Getitemvalue("expChart")(0)
		If me.accountInfos.Contains(account) Then
			Set ai=me.accountInfos.Item(account)
			nature=ai.Nature
		Else
			nature=""
		End If
		writer.WriteCell(nature)
		'Nature Desc
		Dim desc
		desc=GetValueByKey("vwNature", nature, 1, "")
		If IsEmpty(desc) Then
			desc=""
		End If
		writer.WriteCell(desc)
		'Amount
		writer.WriteCell(amount)
		'Source 
		Dim chart As String
		Dim source As String
		chart=LCase(doc.Getitemvalue("expChart")(0))
		If chart="citi" Or chart="others" Or chart="pc" Then
			source="C"
		End If
		If ctg="Bank" Then
			source="C"
		Else
			source="P"
		End If
		writer.WriteCell(source)
		'Type
		Dim sType As String  
		Select Case chart
			Case "citi"
				sType="W"
			Case "others"
				sType="I"
			Case "pc"
				sType="T"
			Case Else 
				sType="E"
		End Select
		writer.WriteCell(sType)
		'Chart of account
		writer.WriteCell(doc.Getitemvalue("expChart")(0) & "-" & code)
		'Expense account
		writer.WriteCell(doc.Getitemvalue("expAccount")(0))		
		'No
		writer.WriteCell(doc.Getitemvalue("No")(0))
		'Pay from
		writer.WriteCell(doc.Getitemvalue("expPayfrom")(0))
		'Office
		writer.WriteCell(office)
		'Unit
		Dim unit As Variant 
		unit=DBLookup("vwOffice", office, 3, "")
		If IsEmpty(unit) Then
			unit=""
		Else
			unit=unit(0)
		End If
		writer.WriteCell(unit)
		'Check No.
	writer.WriteCell(ed.GetParentDoc().Getitemvalue("expCheck")(0))
	End Function
End Class

构造函数New()接受两个用户在界面上选择的分别代表年份和月份的数字，决定后面要导出的数据的范围；设置要从其中导出报表的视图viewExport；初始化报表的列标题。方法ExportData()描述如何找到要导出的数据集合，调用WriteCols方法写入工作表。方法ExportTitle()简单将预设的列标题写入。方法WriteCols()具体计算报表的每一列。

调用的界面和结果如下：