Declare Function NEMGetFile Lib "nnotesws" Alias "NEMGetFile" ( wUnk As Integer, Byval szFileName As String, Byval szFilter As String, Byval szTitle As String ) As Integer 
Declare Function NEMProgressBegin Lib "nnotesws.dll" ( Byval wFlags As Integer ) As Long
Declare Sub NEMProgressEnd Lib "nnotesws.dll" ( Byval hwnd As Long )
Declare Sub NEMProgressSetBarPos Lib "nnotesws.dll" ( Byval hwnd As Long, Byval dwPos As Long)
Declare Sub NEMProgressSetBarRange Lib "nnotesws.dll" ( Byval hwnd As Long, Byval dwMax As Long )
Declare Sub NEMProgressSetText Lib "nnotesws.dll" ( Byval hwnd As Long, Byval pcszLine1 As String, Byval pcszLine2 As String ) 
Const NPB_TWOLINE% = 1 '1 is for the big "in its window" progress bar
Const NPB_NOTEXT%=32 'and 32 is for the small blue line at the bottom of the screen
Const xlAutomatic = -4105
Const xlBottom = -4107
Const xlCategory = 1
Const xlCenter = -4108
Const xlColumnClustered = 51
Const xlContinuous = 1
Const xlDataLabelsShowValue = 2
Const xlDataLabelsShowPercent = 3
Const xlEdgeBottom = 9
Const xlEdgeLeft = 7
Const xlEdgeRight = 10
Const xlEdgeTop = 8
Const xlHairline = 1
Const xlInsideHorizontal = 12
Const xlInsideVertical = 11
Const xlLandscape = 2
Const xlLeft = -4131
Const xlLine=4
Const xlLineMarkers = 65
Const xlLocationAsObject = 2
Const xlMedium = -4138
Const xlNone = -4142
Const xlPie=5
Const xlPortrait = 1
Const xlRows = 1
Const xlThick = 4
Const xlThin = 2
Const xlTop = -4160 
Const xlValue = 2

Sub Click(Source As Button)
	
	'This button will generate an Excel spreadsheet using all data from a view.
	Dim szFilter As String	
	Dim startTime As Single
	Dim processingTime As Single
	Dim session As New NotesSession
	Dim db As NotesDatabase
	Dim v As NotesView
	Dim ws As New notesuiworkspace
	Dim uiview As NotesUIView	
	Dim docX As NotesDocument
	Dim promptlist(4) As String, choice As String
	
	Dim platform As String, view As String
	Dim xl As Variant, xlWbk As Variant, xlSheet As Variant, hwnd As Variant, xlsFileName As Variant
	Dim row As Integer, col As Integer, numdocs As Integer
	
	On Error Goto errorHandler3
	'Check to see if the user is on a MacIntosh
	'the "Create Object" function does not run on a Mac
	platform = session.Platform
	If Not Instr (platform, "MacIntosh") = 0 Then
		Messagebox ("This function cannot be run on a MacIntosh. Please use a PC to pull this data into a spreadsheet.")
		Exit Sub
	End If
	promptlist(0)="New Spreadsheet - Display When Completed *Recommended"	
	promptlist(1)="New Spreadsheet - Save Directly to Disk"
	
	
	choice=ws.prompt(PROMPT_OKCANCELLIST, "Select Action", "Please choose how you would like to perform the export.", promptlist(0), promptlist)
	
	If (choice="") Then
		Exit Sub
	End If
	
	'Get appropriate file names when required
	szFilter = "Excel Spreadsheet|*.xls|All Files|*.*|"	
	If choice = promptlist(0) Then
	Else
		xlsFileName = ws.OpenFileDialog (False, "Please Choose a Location for this Spreadsheet", szFilter,"","Final GO Users")
		If xlsFileName(0) ="" Then
			Exit Sub
		End If		
	End If	
	
	'Set the session variables
	startTime = Timer
	Set db = session.CurrentDatabase
	Set uiview = ws.currentview
	Set v = uiview.view
	numDocs=v.allentries.count	
	
	' Initialise Progress Bar
	hwnd = NEMProgressBegin( NPB_TWOLINE ) ' use window style progress bar
	NEMProgressSetBarRange hwnd, numDocs ' set range of bar to number of rows
	NEMProgressSetText hwnd, "Exporting view to Excel.", "Starting Export to Excel..."
	
	Set xl = CreateObject("Excel.application")
	If choice = promptlist(0) Or choice = promptlist(1) Then
		Set xlWbk = xl.Workbooks.Add
	Else
		Set xlWbk = xl.Workbooks.Open(xlsFileName(0))
	End If
	Set xlSheet = xlWbk.Worksheets(1)
	Call xlSheet.Activate
	On Error Goto errorHandler    
	xlSheet.Name = "Notes Exported Data"
	xl.Cells.select     
	xl.Selection.ClearContents
	
	'Start filling in the header column.  You can get rid of this if you want to, but then get rid of the section lower that highlights it...
	col=1
	With xlSheet
		Forall vColumn In v.Columns               
			If vColumn.IsHidden = True Then
			Else                    
				.Cells(1, col)=vColumn.Title
				col=col+1
			End If
		End Forall
	End With               
	
	
	'Row by Row, Column by Column, fill in the values
	Set docX=v.GetFirstDocument
	row=2
	On Error Goto errorHandler
	With xlSheet          
		While Not docX Is Nothing
			col=1
			Forall cValue In docX.ColumnValues
				.Cells(row, col)=csImplode("'" & cValue, Chr(10))
continue:
				col=col+1
			End Forall
			row=row+1
			If row Mod 10 = 0 Then
				processingTime = Timer - startTime               
				NEMProgressSetBarPos hwnd,row
				NemProgressSetText hwnd, "Exporting view to Excel.", "Exporting: "& Cstr(row) & " of " & Cstr(numDocs) & " documents exported in "  & Format$(processingTime, "0.00") & " seconds, AVG = " & Format$(row / processingTime , "0.000")
			End If
			Set docX=v.GetNextDocument(docX)
		Wend
	End With
	On Error Goto errorHandler2
	
	'Set sizing, fonts, etc to make the spreadsheet readable.
	xl.Cells.select
	xl.selection.Font.Name = "MS Sans Serif"
	xl.selection.Font.Size = 9
	xl.Rows("1:1").Select
	xl.Selection.Font.Bold = True
	xl.selection.Font.size = 12
	xl.selection.RowHeight = 15		
	xl.Cells.select
	xl.selection.columnwidth = 100
	xl.selection.columns.Autofit	
	xl.selection.rows.Autofit
	xl.selection.VerticalAlignment = xlTop
	xl.ActiveSheet.Range("A1").Select
	
	'Stop Progress Bar
	NEMProgressEnd hwnd 
	
	'Save and be gone!
	On Error Goto errorHandler3
	If choice = promptlist(1) Or choice = promptlist(3) Then
		Call xlWbk.SaveAs(xlsFileName(0))
		Call xlWbk.Close
		Messagebox "Export is Complete.  You may now open the saved spreadsheet: "&xlsFileName(0)
		Call xl.Quit
		xl = ""
	Else
		xl.Visible=True
	End If
' LotusScript code...
	processingTime = Timer - startTime
	Print "File created in " & Format$(processingTime, "0.00") & " seconds."     
	Exit Sub
	
errorHandler:
'This is called when there is bad data in a notes view, usually text in a date field, etc.
'Notes will show it, but it will fail to export correctly.  This replaces the Excel cell with a bad data text.
	Resume
	
errorHandler2:
	NEMProgressEnd hwnd	
	Messagebox "Bad Options setting Spreadsheet format"
	xl = ""
	Exit Sub
	
errorHandler3:
	NEMProgressEnd hwnd	
	Messagebox "Bad Filename Specified.  Please make sure that the directory name is correct."
	xl = ""
	Exit Sub
End Sub

Function csImplode(Array As Variant,Separator As String) As String
	
	Dim text As String
	Dim i As Integer
	If Isarray(Array) Then
		For i=0 To Ubound(Array)
			If i=Ubound(Array) Then
				text=text & array(i)
			Else
				text=text & array(i) & separator
			End If
		Next
		csImplode=text
	Else
		csImplode=Array
	End If
	
End Function