Colorful Life2010

Lotus Notes C/S模式下导出当前VIEW的数据到EXCEL




Sub Click(Source As Button)
	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
	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
	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
	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, ",")
				oVal$ = Cstr(colVal)
			End If
			xlsheet.Cells(iRow, iCol).value = oVal
			iCol = iCol + 1
		End Forall
		iRow = iRow + 1
		Set entry = vc.GetNextEntry(entry)
	'save the Excel file
	xlApp.ActiveWindow.FreezePanes = False
	xlApp.ActiveWindow.SplitRow = 1
	xlApp.ActiveWindow.FreezePanes = True
	xlApp.ScreenUpdating = True 
	'Destroy the dialog when we're done
	NEMProgressEnd hwnd
	Exit Sub
End Sub
历史上的今天: [2011/08/01]CL命令实现一个SRC-PF内所有MBR的内容查找,并导出LIST

[Lotus Notes C/S模式下导出当前VIEW的数据到EXCEL]的回复

Post a Comment~