Export to excel or csv using lotus script

Here is the pretty simple lotus script to export the current view to excel or csv. It can export either selected documents from the current view or entire view.

Sub Initialize

	Dim w As New NotesUIWorkspace

	Dim response As Variant
	Dim values(2) As Variant
	values(0) = "All"
	values(1) = "Selected"
	values(2) = "test view columns"
	response = w.Prompt (PROMPT_OKCANCELLIST, _
	"Export", _
	"Select an Option to Export", _
	values(0), values)
	If IsEmpty (response) Then
		MessageBox "User canceled", , "Export"
	Else
		If response = "All" then
			Call export2XL_expert1("All")
		ElseIf response = "Selected" Then
			Call export2XL_expert1("Selected")
		Else
			Call viewColumn(w.Currentview.view)
		End if
	End If

End Sub

Sub export2XL_expert1(sType As String)
	On Error GoTo processerror
	Dim Session As New NotesSession
	Dim db As NotesDatabase
	Dim dataview As NotesView
	Dim dc As NotesDocumentCollection
	Dim datadoc As NotesDocument
	Dim maxcols As Integer

	Dim IsExcel As Boolean
	Dim IsCSV As Boolean
	IsExcel = False
	IsCSV = false
	Dim ViewString As String

	Set db = session.CurrentDatabase

	Dim w As New NotesUIWorkspace
	ViewString= w.Currentview.Viewname
	Set dataview = db.getview(ViewString)

	Dim exportType As Variant
	Dim values(1) As Variant
	values(0) = "CSV"
	values(1) = "Excel"
	exportType = w.Prompt (PROMPT_OKCANCELLIST, _
	"Export", _
	"Select an Option to Export", _
	values(0), values)
	If IsEmpty (exportType) Then
		MessageBox "Export canceled", , "Export"
		Exit Sub
	Else
		If exportType = "Excel" Then
			IsExcel = True
		ElseIf 	exportType = "CSV" Then
			IsCSV = true
		End If
	End if	

	Dim fname As Variant
	If IsExcel then
		fname = w.Savefiledialog(False, "Export", "*.xls", "c:\", "c:\temp\test.xls")
	Else
		fname = w.Savefiledialog(False, "Export", "*.csv", "c:\", "c:\temp\test.csv")
	End If

	Dim xlApp As Variant
	Dim xlsheet As Variant
	Dim rows As Integer
	Dim cols As Integer
	Dim myStream As NotesStream
	rows = 1
	cols = 1
	maxcols= dataview.columncount

	If IsExcel Then
		Set xlApp = CreateObject("Excel.Application")
		xlApp.StatusBar = "Creating WorkSheet. Please be patient..."
		xlApp.Visible = False
		xlApp.Workbooks.Add
		xlApp.ReferenceStyle = 2
		Set xlsheet = xlApp.Workbooks(1).Worksheets(1)
		xlsheet.Name = "Export From Notes" ' ViewString
		xlapp.activeworkbook.saveas fname(0)
	ElseIf IsCSV Then
		Set myStream = session.Createstream()
		Call myStream.Open(fname(0), "ASCII")
		Call myStream.Truncate()
	End If

	Dim x As Integer
	For x=1 To maxcols
		With dataview.Columns(x-1)
		If .isHidden Or .IsHideDetail Then
			'do nothing
		Else
			If IsExcel Then
				xlsheet.Cells(rows,cols).Value = dataview.columns(x-1).title
			Else
				If x= maxcols Then
					Call myStream.Writetext(dataview.columns(x-1).title, 0) ' add end of line for last column
				Else
					Call myStream.Writetext(dataview.columns(x-1).title & ",")
				End If

			End if
			cols = cols + 1

		End If
		End With
	Next

	If sType = "All" Then
		Set datadoc = dataview.getfirstdocument
	ElseIf sType = "Selected" Then
		Set dc = db.Unprocesseddocuments
		Print dc.count & " are selected for export"
		Set datadoc = dc.Getfirstdocument()
	End If

	Dim fitem As NotesItem
	cols=1
	rows=2
	Dim var As Variant, tmp As String, fld As String, i As integer

	Do While Not (datadoc Is Nothing)

		For x=1 To maxcols
			With dataview.Columns(x-1)
				If .isHidden Or .IsHideDetail Then
					'do nothing
				ElseIf .isField Then
					fld = .itemname
					var = FullTrim(datadoc.GetItemValue(.itemname))
				ElseIf .isFormula Then
					If .formula="@IsExpandable" Then
						var = ""
					Else
						var = FullTrim(Evaluate(.formula,datadoc))
					End If
				End If

				If IsEmpty(var) Then
					tmp = ""
				Else
					If IsExcel Then
						If IsEmpty(var) Then
							tmp = ""
						elseIf IsArray(var) Then
							tmp = join(var,",")
						Else
							tmp = var(0)
						End If
					ElseIf IsCSV Then
						'If multi-value, join into single string surrounded by quotes.
						'If value has a comma, surround with quotes
						If IsEmpty(var) Then
							tmp = ""
						elseIf IsArray(var) Then
							tmp = |"| & Join(var, ",") & |"|
						Else
							If InStr(var, ",") > 0 Then
								tmp = |"| & var & |"|
							Else
								tmp = var
							End If
						End If

					End If

				End If					

				If IsCSV Then
					If x= maxcols Then
						Call myStream.Writetext(tmp , 0)
					Else
						Call myStream.Writetext(tmp &",")
					End If

				Else
					xlsheet.Cells(rows,cols).Value =  tmp
				End If

			End With
			cols=cols+1
		Next

		rows=rows+1
		cols=1
		If sType = "All" Then
			Set datadoc = dataview.getnextdocument(datadoc)
		ElseIf sType = "Selected" Then
			Set datadoc = dc.Getnextdocument(datadoc)
		End If

	Loop
	If IsExcel Then
		xlApp.Rows("1:1").Select
		xlApp.Selection.Font.Bold = True
		xlApp.Selection.Font.Underline = True
		xlApp.Range(xlsheet.Cells(1,1), xlsheet.Cells(rows,maxcols)).Select
		xlApp.Selection.Font.Name = "Arial"
		xlApp.Selection.Font.Size = 9
		xlApp.Selection.Columns.AutoFit
		With xlApp.Worksheets(1)
			.PageSetup.Orientation = 2
			.PageSetup.centerheader = "Report - Confidential"
			.Pagesetup.RightFooter = "Page &P" & Chr$(13) & "Date: &D"
			.Pagesetup.CenterFooter = ""
		End With
		xlApp.ReferenceStyle = 1
		xlApp.Range("A1").Select
		xlApp.StatusBar = "Importing Data from Lotus Notes Application was Completed."
		'xlapp.activeworkbook.saveas fname(0)
		xlapp.activeworkbook.save

		If MessageBox("Report generation complete.  Would you like to open the Excel file now? ", 4 + 32, "Report Generated") = 6 Then
			xlapp.visible = True
		Else
			xlapp.quit
		End If
	elseIf IsCSV Then
		Call myStream.Close()
		Set myStream = Nothing
	End if
	Exit Sub
processerror:
	MsgBox "ERROR on line " & CStr(Erl) & " (" & CStr(Err) & ") - " & Error$
	If IsObject(xlapp) then
		xlapp.quit
	Elseif IsObject(myStream) Then
		Call myStream.Close()
		Set myStream = Nothing
	End if	

End Sub