C/S模式下导出当前VIEW的数据到EXCEL代码,Domino代码库,德仔网

代码语言

代码分类

【Domino】 C/S模式下导出当前VIEW的数据到EXCEL

作者:entry / 发布于2014/7/25/ 980

前提：机器上当然要状有EXCEL了将下面的代码直接放到VIEW的一个ACTION按钮上就行了这个还包含了前一篇的进度条的功能


	Sub Click(Source As Button)
	'define
	Dim ws As New NotesUIWorkspace
	Dim se As New NotesSession
	Dim db As NotesDatabase
	Dim view As NotesView
	Dim entry As NotesViewEntry
	Dim iRow As Integer
	Dim iCol As Integer
	Dim oVal As String
	Dim vc As NotesViewEntryCollection
	Dim maxrows As Integer
	' EXCEL
	Dim xlApp As Variant ' Excel Application
	Dim xlbook As Variant ' Workbook
	Dim xlsheet As Variant ' Worksheet
	
	'get the data view
	Set db = se.CurrentDatabase
	Set view = ws.CurrentView.View
	
	If Messagebox("confirm to export the view data?", 32 + 1, "Exporting Data") <> 1 Then Exit Sub
	
	' EXCEL
	Set xlApp = CreateObject("Excel.Application")
	xlApp.Visible = True
	Set xlbook = xlApp.Workbooks.Add
	Set xlsheet = xlbook.Worksheets(1)
	xlApp.ScreenUpdating = False
	
	Set vc = view.AllEntries
	Set entry = vc.GetFirstEntry
	'titles
	xlsheet.Rows(1).NumberFormat = "@"
	iCol = 1
	Forall col In view.Columns
	 xlsheet.Cells(1, iCol).Value = col.Title
	 iCol = iCol + 1
	End Forall
	iRow = 2
	maxrows = vc.Count
	
	'Create the progress bar
	hwnd = NEMProgressBegin( NPB_TWOLINE )
	'Set the bar range - the default is 100
	NEMProgressSetBarRange hwnd, maxrows
	'Display some text on the dialog. The second line is ignored if NPB_TWOLINE not specified
	NemProgressSetText hwnd, "Exporting Data...", ""
	
	On Error Goto goout
	While Not(entry Is Nothing)
	 'update process bar's status & text
	 NEMProgressSetBarPos hwnd, iRow-1
	 NemProgressSetText hwnd, "Exporting Data...", Cstr(iRow-1) &" record(s) have been processed..."
	
	 iCol = 1
	 Forall colVal In entry.ColumnValues
	 If Instr(Typename(colVal), "STRING") = 1 Then ' STRING or STRING( )
	 xlsheet.Cells(iRow, iCol).NumberFormat = "@"
	 End If
	 If Isarray(colVal) Then
	 oVal$ = Implode(colVal, ",")
	 Else
	 oVal$ = Cstr(colVal)
	 End If
	 xlsheet.Cells(iRow, iCol).value = oVal
	 iCol = iCol + 1
	 End Forall
	
	 iRow = iRow + 1
	 Set entry = vc.GetNextEntry(entry)
	Wend
	
	'save the Excel file
	xlApp.ActiveWorkbook.Worksheets(1).Rows.RowHeight=14
	xlApp.ActiveWorkbook.Worksheets(1).Columns.AutoFit
	xlApp.ActiveWindow.FreezePanes = False
	xlApp.ActiveWindow.SplitRow = 1
	xlApp.ActiveWindow.FreezePanes = True
	xlApp.ScreenUpdating = True
	goout:
	'Destroy the dialog when we're done
	NEMProgressEnd hwnd
	Exit Sub
	End Sub

评论列表

本站所提供的代码，版权归原作者所有，若有侵犯作者版权，请与我们联系，我们将立即删除或修改。谢谢!
本站所有代码发布及提供者。

试试其它关键字

　EXCEL　　VIEW　

同语言下

可能有用的

entry贡献的其它代码(10)