[Lotus]如何把视图导出到Excel

如何把可见视图所有值用程序控制直接导出到Excel？

热心网友

Sub WriteToExcel'本字程序功能为写入数据到指定的Excel文件里,用户选定的文档将被输出。'[处理视图]-初始化视图Dim ws As New NotesUIWorkspaceDim uiView As NotesUIViewDim View As NotesViewDim col As NotesViewColumnDim s As New NotesSessionDim db As NotesDatabaseDim cl As NotesDocumentCollectionSet uiView = ws。CurrentViewSet View = uiView。ViewSet db = s。CurrentDatabaseSet cl = db。UnprocessedDocuments '初始化Excel对象Dim xlApp As VariantDim xlsheet As VariantSet xlApp = CreateObject("Excel。application")xlApp。StatusBar = "Creating WorkSheet。 Please be patient。。。"xlApp。Visible = TruexlApp。Workbooks。AddxlApp。ReferenceStyle = 2Set xlsheet = xlApp。Workbooks(1)。Worksheets(1) '[处理视图]-读取列名Dim ReadColumnTitle() As StringRedim ReadColumnTitle(0 To Ubound(View。Columns)) As StringFor i = 0 To Ubound(View。Columns)ReadColumnTitle(i)=View。Columns(i)。titleNextCall WriteToExcelRow("A",2,xlsheet,ReadColumnTitle) '[处理视图]-读取内容Dim tDoc As NotesDocumentDim ReadViewResultDim j As IntegerSet tDoc = cl。GetFirstDocumentj=3While Not tDoc Is NothingReadViewResult = ReadRow(View,tDoc)Call WriteToExcelRow("A",j,xlsheet,ReadViewResult)Set tDoc = cl。GetNextDocument(tDoc)j=j+1Wend '保存文件xlApp。Rows("2:1")。SelectxlApp。Selection。Font。Bold = TruexlApp。Selection。Font。Underline = TruexlApp。Range(xlsheet。Cells(1,1), xlsheet。Cells(j,Ubound(View。Columns)+1))。SelectxlApp。Selection。Font。Name = "Arial"xlApp。Selection。Font。Size = 9xlApp。Selection。Columns。AutoFitWith xlApp。Worksheets(1)。PageSetup。Orientation = 2。PageSetup。centerheader = "Report - Confidential"。Pagesetup。RightFooter = "Page &P" & Chr$(13) & "Date: &D"。Pagesetup。CenterFooter = ""End WithxlApp。ReferenceStyle = 1xlApp。Range("A1")。SelectxlApp。StatusBar = "Importing Data from Lotus Notes Application was Completed。"End SubFunction ReadRow( tView As NotesView , tDoc As NotesDocument ) As Variant'该函数为把视图中某定位文档的所有视图显示值放入一个ReadRow的数组里，tView为所要操作的视图，tDoc为所定位的文档Dim tResultArray() As StringtLength% = Ubound(tView。Columns)Redim tResultArray(0 To tLength%) As StringFor i = 0 To Ubound(tView。Columns) Set col = tView。Columns(i)tValue$ = col。ItemNamevFormula$ = col。FormulaIf col。Formula ="" ThenvResult = Evaluate(tValue$,tDoc)ElsevResult = Evaluate(vFormula$,tDoc)End IftResultArray(i) = vResult(0)NextReadRow = tResultArrayEnd FunctionSub WriteToExcelRow( tR As String,tC As Integer,xlsheet As Variant,tValue As Variant)With xlsheetFor i = 0 To Ubound(tValue)tLoca=Chr(Asc(tR)+i)+Cstr(tC)。Range(tLoca)。Value = tValue(i)NextEnd WithEnd Sub。