Option Explicit
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(1) 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)="Open the file now"		 
	promptlist(1)="Save it to your computer"
	choice=ws.prompt(PROMPT_OKCANCELLIST, "Export", "Would you like to open the file or save it to your computer?", promptlist(0), promptlist)
	If (choice="") Then Exit Sub
	
	 'Get appropriate file names when required
	szFilter = "Excel Spreadsheet|*.xls|All Files|*.*|"		 
	If choice <> promptlist(0) Then
		xlsFileName = ws.SaveFileDialog (False, "Select Spreadsheet", szFilter)
		If xlsFileName(0) ="" Then Exit Sub 		 
	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            
				.Cells(1, col)=vColumn.Title
				col=col+1
			End If
		End Forall
	End With               
	
	'¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥ START DOC LOOP ¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥
	Dim vecollect As notesViewEntryCollection
	Set vecollect = v.AllEntries
	Dim entry As NotesViewEntry
	Set entry = vecollect.GetFirstEntry()
	Dim LastColumn As Integer
	LastColumn = Ubound(v.columns)
	Dim b As Integer
	row=2
	On Error Goto errorHandler
	
	Do
		col=1
		For b = 0 To LastColumn
			If v.Columns(b).IsHidden <> True Then
				xlSheet.Cells(row, col)= "'" & entry.ColumnValues(b) 
				col=col+1
			End If
		Next b
		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 entry = vecollect.getnextentry(entry)
	Loop Until entry Is Nothing
	
	On Error Goto errorHandler2
	'¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥ END DOC LOOP¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥
	
	'Set sizing, fonts, etc to make the spreadsheet readable.
	xl.Cells.select
	xl.selection.Font.Name = "Verdana"
	xl.selection.Font.Size = 8
	xl.Rows("1:1").Select
	xl.Selection.Font.Bold = True
	xl.selection.Font.size = 8
	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) Then
		Call xlWbk.SaveAs(xlsFileName(0))
		Call xlWbk.Close
		Messagebox "You may now open the saved spreadsheet: "& Chr(10) & Chr(10) & xlsFileName(0), 0 + 64, "Export Complete"
		Call xl.Quit
		xl = ""
	Else
		xl.Visible=True
	End If
' LotusScript code...
	processingTime = Timer - startTime
	Print "The script ran 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"
	Call xl.Quit
	xl = ""
	Exit Sub
	
errorHandler3:
	NEMProgressEnd hwnd		 
	Messagebox "Bad Filename Specified.  Please make sure that the directory name is correct."
	Call xl.Quit
	xl = ""
	Exit Sub
	
End Sub

Function ImplodeCode(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
		ImplodeCode=text
	Else
		ImplodeCode=Array
	End If
	
End Function