Dim session As NotesSession
Dim erisdb As NotesDatabase
Dim compdb As NotesDatabase
Dim exportdb As NotesDatabase
Dim server$, path$
Dim sourceview As NotesView
Dim headerview As NotesView
Dim controlview As Notesview
Dim detailvcollection As NotesViewEntryCollection
Dim docvcollection As NotesViewEntryCollection
Dim headervcollection As NotesViewEntryCollection
Dim detailentry As NotesViewEntry
Dim docentry As NotesViewEntry
Dim headerentry As NotesViewEntry
Dim detaildoc As NotesDocument
Dim headerdoc As NotesDocument
Dim doc As NotesDocument
Dim filename As String
Dim filenum As Integer
Dim detailtxt As String
Dim headertxt As String
Dim detailarray () As String
Dim sourceviewname As String
Dim outputfile As String
Dim npslog As NotesLog
Dim DetailEntryType() As String
Dim DetailFieldName() As String
Dim DetailFieldType() As String
Dim DetailReplaceNull() As String
Dim DetailReplaceValue() As String
Dim DetailDateFormat() As String

Sub Initialize
	
	Dim ws As New notesuiworkspace
	Dim tabs As Variant
	Dim xlsFileName As Variant
	Dim y As Integer
	Dim i As Double, k As Double, m As Double, n As Double
	
	Set session = New NotesSession
	Set exportdb = session.CurrentDatabase	
	
	GetServerAndPath server, path
	
	'Start the Notes Log 
	Set npslog = New NotesLog("Export Brio Report Agent")
	npslog.OPENNOTESLOG server, path & exportdb.filename
	npslog.LogAction "*** BRIO REPORT EXPORT STARTED (" & Cstr(Now) & ") ***" 
	
	'#########################################################################
	' Start the process of export to Excel by gathering some information from the user
	'#########################################################################	
	
	' Get the path and filename from user profile
	Dim profileview As NotesView
	Set profileview = exportdb.GetView( "Profile" )
	Dim profiledoc As NotesDocument
	Set profiledoc = profileview.GetFirstDocument
	
	If profiledoc Is Nothing Then
		'Get appropriate file names when required
		Dim szFilter$
		szFilter = "Excel Spreadsheet|*.xls|All Files|*.*|"	
	     'Prompt user where to save the file
		xlsFileName = ws.OpenFileDialog(False, "Please choose a location for this spreadsheet", szFilter,"","Resource.xls")
		If xlsFileName(0) ="" Then
			Messagebox "You have not selected a location for this spreadsheet. Please retry again.", 48, "Selection Error"
			Exit Sub
		End If
	Else
		Redim xlsFileName(0) As String
		xlsFileName(0) = profiledoc.path(0) & profiledoc.filename(0)
	End If
	
	'********************************* Checks for Target Path **************************************
	'On Error Resume Next needs to be included to allow the code below to check for errors and continue
	On Error Resume Next
	
	Dim TargetPath$
	TargetPath = profiledoc.path(0)
	
	Chdir TargetPath									'Check that the TargetPath exists
	
	If Err = 76 Then									'If it did not exist, peform these tasks
		Mkdir TargetPath 								'Create the TargetPath
		Err = 0											'Reset Error Number for next check
		Chdir TargetPath 								'Verify that the TargetPath was successfully created
		If Err = 76 Then 								'If it wasn't created successfully
			Msgbox "Excel Path does not exist or could not be created, please specify another path in the profile document.", 0 + 16, "Invalid Path"
		End If
	End If
	
	'****************************************************************************************************
	
	On Error Goto errorHandler    
	
	' Get the array of  tabs to be processed
	Set headerview = exportdb.GetView("ColumnHeaders")
	Set controlview = exportdb.GetView("NPSM")
	tabs = Evaluate("@Unique(@DbColumn("""":""NoCache"";"""";""NPSM"";2))")
	
	Dim RangeBounds() As String
	Redim RangeBounds(Ubound(tabs)) As String
	
	y = 1
	Forall t In tabs
		
		'Open File and Write Header
		filenum = Freefile()
		outputfile = profiledoc.path(0) & t & ".csv"
		Open outputfile For Output As filenum
		
		'Process column headers to the tab
		Call AddColumnHeaders(t, headerview)
		
		Print "Processing contents for tab: " & Ucase(t)
		npslog.LogAction "          Processing contents for tab: " & Ucase(t)
		
	     'Get the first detail record to set the source view. All control documents must 
		'be referencing the same view. Mixing source views will cause problems in data.
		Set detailvcollection = headerview.GetAllEntriesByKey(t, True)
		Set detailentry = detailvcollection.GetfirstEntry
		Set detaildoc = detailentry.Document
		
		sourceviewname = detaildoc.NPS_SourceView(0)
		
          'Set the source database and view
		If detaildoc.NPS_SourceDB(0) = "Compensation Manager" Then
			Set compdb = session.GetDatabase(server, path & "eriscomp.nsf" )
			If Not(compdb.IsOpen) Then	'Verify if db is open
				Messagebox "The Compensation Database could be opened.", 48, "Database Open Error"
				Exit Sub
			End If
			Set sourceview = compdb.GetView(sourceviewname)
		Elseif detaildoc.NPS_SourceDB(0) = "Brio Reporting" Then
			'No need to check current db
			Set sourceview = exportdb.GetView(sourceviewname)
		Else
			Set erisdb= session.GetDatabase(server, path & "eris.nsf" )
			If Not(erisdb.IsOpen) Then 	'Verify if db is open
				Messagebox "The Filing Cabinet Database could be opened.", 48, "Database Open Error"
				Exit Sub				
			End If
			Set sourceview = erisdb.GetView(sourceviewname)
		End If
		
		If sourceview Is Nothing Then
			Messagebox "You specified an incorrect source view: " & sourceviewname & ". Please retry again.", 48, "Source View Error"
			Exit Sub
		End If
		
		Set docvcollection = sourceview.AllEntries
		
		'Populate only when there are records to process
		If docvcollection.count > 0 Then
			
			npslog.LogAction "                        " & Cstr(docvcollection.count) & " records for tab: " & Cstr(Ucase(t))
			
			Call DetailInstruction(detailvcollection)
			
			Set docentry = docvcollection.getfirstentry
			
			i = 1
			
			Do
				
				Set doc = docentry.document
				
				Print "Processing Row: " & Cstr(i) & " of " & (docvcollection.count) & " for tab: " & Ucase(t)
				Redim detailarray(0 To (detailvcollection.count - 1)) As String
				
				For k = 0 To (detailvcollection.count -1)	
					detailarray(k) = ProcessDetailRecord(doc, DetailEntryType(k), DetailFieldName(k), DetailFieldType(k), DetailReplaceNull(k), DetailReplaceValue(k), DetailDateFormat(k))
				Next
				
				n = 0
				detailtxt = ""
				Forall d In detailarray
					If n = 0 Then
						detailtxt = Chr(34) & d & Chr(34)
					Else
						detailtxt = detailtxt & "," & Chr(34) & d & Chr(34)
					End If
					n = n + 1
				End Forall
				
				Print #filenum, detailtxt	
				i = i + 1
				
				Set docentry = docvcollection.getnextentry(docentry)
				
			Loop Until docentry Is Nothing
			
			Close filenum
			
		End If
		
		'Populate  Rangebounds		
		RangeBounds(y-1) = CalculateRangeBounds (detailvcollection.Count) & docvcollection.count + 1
		
		'increment to next tab
		y = y + 1
		
	End Forall	
	
	npslog.LogAction "          Converting to Excel (" & Cstr(Now) & ") ***" 
	
	Call CopyCSVtoExcel ( Tabs , RangeBounds, TargetPath, Cstr(xlsFilename(0)) )
	
	npslog.LogAction "*** BRIO REPORT EXPORT COMPLETE (" & Cstr(Now) & ") ***" 
	Print "BRIO Report Export is complete."
	
	Exit Sub
	
errorHandler:
	Messagebox "Error was encountered.  Please make sure that all the control documents are correct."
	
End Sub

Function CopyCSVtoExcel( tabs As Variant, RangeBounds() As String, TargetPath As String , xlsFilename As String)
	
	Dim xl As Variant
	Dim xlwbksFinal As Variant
	Dim xlWbkFinal As Variant, xlSheetsFinal As Variant, xlSheetFinal As Variant
	Dim xlWbkTemp As Variant, xlSheetsTemp As Variant, xlSheetTemp As Variant

	'Create the Excel Object
	Set xl = CreateObject("Excel.application")
	xl.visible = True

	'Create Final Workbook
	Set xlWbkFinal = xl.Workbooks.Add
	Set xlSheetsFinal = xlWbkFinal.Worksheets
	Set xlSheetFinal = xlWbkFinal.Worksheets(1)

	Dim y As Integer
	y = 1
	
	Forall t In tabs
		
		Print "Processing Excel Tab for " & T
		
		'Create Workbooks
		Set xlWbkTemp = xl.Workbooks.Open (TargetPath & t & ".csv")
		Set xlSheetsTemp = xlWbkTemp.Worksheets
		
	                'Initiate first worksheet based on the array of tab names
		Set xlSheetTemp = xlWbkTemp.Worksheets(1)
		Call xlSheetTemp.Activate
		xlSheetTemp.Name = t
		
		'Sets the Range Name = to the tab name (no spaces allowed)
		xlSheetTemp.Range("A1:" & RangeBounds(y-1)).Name = Cstr(t)
		
		xlSheetTemp.Name = t
		xlSheetsTemp(t).Select
		
		Call xlSheetsTemp.Move(xlWbkFinal.Worksheets(y))		
		
		Kill  TargetPath & t & ".csv"
		
		'Format the xl sheet
		xl.Cells.select
		xl.selection.columns.Autofit	
		xl.selection.rows.Autofit
		xl.ActiveSheet.Range("A1").Select
		
		'increment to next tab
		y = y + 1
		
	End Forall
	
	'Delete the extra sheets that were created by default in Excel
	xl.DisplayAlerts = False
	xlSheetsFinal ("Sheet1").Delete
	xlSheetsFinal ("Sheet2").Delete
	xlSheetsFinal ("Sheet3").Delete
	
	'Save only if there were tabs processed
	Call xlWbkFinal.SaveAs(xlsFileName)
	Call xlWbkFinal.Close
	Call xl.Quit
	
	'Release object handles
	xlSheetFinal = ""
	xlSheetsFinal = ""
	xlWbkFinal = ""
	xlSheetTemp = ""
	xlSheetsTemp = ""
	xlWbkTemp = ""
	xl = ""
	
	Messagebox "Export is Complete.  You may now open the saved spreadsheet: "  & xlsFileName
	
End Function

'**********************************************************************************************

Function CalculateRangeBounds (ColumnCount As Long) As String
	
	' Used to calculate the column labels for the number of columns (i.e. 44 columns would equal AR )
	
	Dim AlphabetArray(1 To 26) As String
	AlphabetArray(1) = "A"
	AlphabetArray(2) = "B"
	AlphabetArray(3) = "C"
	AlphabetArray(4) = "D"
	AlphabetArray(5) = "E"
	AlphabetArray(6) = "F"
	AlphabetArray(7) = "G"
	AlphabetArray(8) = "H"
	AlphabetArray(9) = "I"
	AlphabetArray(10) = "J"
	AlphabetArray(11) = "K"
	AlphabetArray(12) = "L"
	AlphabetArray(13) = "M"
	AlphabetArray(14) = "N"
	AlphabetArray(15) = "O"
	AlphabetArray(16) = "P"
	AlphabetArray(17) = "Q"
	AlphabetArray(18) = "R"
	AlphabetArray(19) = "S"
	AlphabetArray(20) = "T"
	AlphabetArray(21) = "U"
	AlphabetArray(22) = "V"
	AlphabetArray(23) = "W"
	AlphabetArray(24) = "X"
	AlphabetArray(25) = "Y"
	AlphabetArray(26) = "Z"
	
	If ColumnCount <= 26 Then
		CalculateRangeBounds = AlphabetArray(ColumnCount)
	Else
		Dim FirstLetter As String
		FirstLetter = AlphabetArray(Left$((ColumnCount / 26) , 1 ))
		
		Dim SecondLetter As String
		Dim ModValue As Variant
		ModValue =  ColumnCount Mod 26
		SecondLetter = AlphabetArray(ModValue)
		
		CalculateRangeBounds = FirstLetter & SecondLetter
		
	End If
	
End Function

'**********************************************************************************************

Function GetServerAndPath (server As String, path As String)
	Dim ss As New notessession
	Dim db As notesdatabase
	Dim i As Integer
	
	Set db=ss.currentdatabase
	server=db.server
	
	path=""
	For i=Len (db.filepath) To 1 Step -1
		If Mid(db.filepath,i,1)="\" Then
			If i > 1 Then
				path =Left (db.filepath, i-1) & "\"
			End If
			Exit For
		End If
	Next
End Function

'**********************************************************************************************

Function ProcessDetailRecord(doc As NotesDocument, EntryType As String, Field As String, FieldType As String, ReplaceNull As String, ReplaceValue As String,DateFormat As String) As String
	
	' Collect and Write the details of each record the export file
	
	Dim item As NotesItem
	Dim tdate As NotesDateTime
	Dim length As Integer
	Dim composedby()
	Dim text
	
	ProcessDetailRecord = ""
	
	Select Case Ucase(EntryType)
		
	Case "STATIC"
		
		If detaildoc.NPS_FieldType(0) = "Text" Then
			ProcessDetailRecord = Field
		Elseif detaildoc.NPS_FieldType(0) = "Number" Then
			ProcessDetailRecord = Field
		End If
		
	Case "FIELD"
		
		'For Header Field is only set for accumulate
		Dim fieldname As String
		fieldname = Field
		
		'Check source item
		Set item = doc.GetFirstItem(fieldname)
		
		Redim text(0) As Variant
		If item Is Nothing Then
			If ReplaceNull = "Yes" Then
				text(0) = ReplaceValue
			Else
				text(0) = ""
			End If
		Else
			text(0) = item.text		
		End If
		
		
		If FieldType = "Date" Then
			
			If Cstr(text(0)) = "" Then
				If ReplaceNull = "Yes" Then
					text(0) = ReplaceValue
				Else
					text(0) = ""
				End If
			End If
			
			If Cstr(text(0)) <> "" Then
				If DateFormat = "YYYYMMDD" Then
					ProcessDetailRecord = Format$(text(0), "yyyy/mm/dd")			
				Else
					ProcessDetailRecord = Format$(text(0), "mm/dd/yyyy")
				End If
			Else
				ProcessDetailRecord = ""
			End If
			
		Else ' Process for FieldType Text and Number
			
			If Cstr(text(0)) <> "" Then
				ProcessDetailRecord = Cstr(text(0))
			Else
				If ReplaceNull = "Yes" Then
					ProcessDetailRecord = ReplaceValue
				Else
					ProcessDetailRecord = ""
				End If
			End If
			
		End If	
		
	End Select
	
End Function

'**********************************************************************************************

Function AddColumnHeaders(t As Variant, headerview As NotesView)
	
	'Process the column headers for each tab
	Print "Processing Column Headers for Tab: " & Cstr(Ucase(t))
	Set headervcollection = headerview.GetAllEntriesByKey(t, True)
	
	Dim row As Double, col As Double
	
	headertxt = ""
	
	If headervcollection.count > 0 Then
		Set headerentry = headervcollection.GetfirstEntry
	     'Write the contents to the first row
		col = 1
		Do
			Set headerdoc = headerentry.Document
			If col = 1 Then
				headertxt = Chr(34) & headerdoc.NPS_Fieldname(0) & Chr(34)
			Else
				headertxt = headertxt & "," & Chr(34) & headerdoc.NPS_Fieldname(0) & Chr(34)
			End If
			
			col = col + 1
			
			Set headerentry = headervcollection.GetNextEntry(headerentry)
		Loop Until headerentry Is Nothing	
	End If
	
	Print #filenum, headertxt
	
End Function

'**********************************************************************************************

Function DetailInstruction(vc As NotesViewEntryCollection)
	
	'This will make arrays of detail instructions for each document to process 
	
	Redim DetailEntryType(0 To (vc.count -1)) As String
	Redim DetailFieldName(0 To (vc.count - 1)) As String
	Redim DetailFieldType(0 To (vc.count -1)) As String
	Redim DetailReplaceNull(0 To (vc.count -1)) As String
	Redim DetailReplaceValue(0 To (vc.count -1)) As String
	Redim DetailDateFormat(0 To (vc.count -1)) As String
	
	Dim entry As NotesViewEntry
	Dim doc As NotesDocument
	Dim x As Integer
	
	Set entry = vc.GetFirstEntry
	x = 0
	
	Do 
		Set doc = Entry.Document 
		
		DetailEntryType(x) = doc.NPS_EntryType(0)
		
		If doc.NPS_EntryType(0) = "Field" Then
			DetailFieldName(x) = doc.NPS_Fieldname(0)
		Else
			DetailFieldName(x) = doc.NPS_StaticFieldValue(0)
		End If
		
		DetailFieldType(x) = doc.NPS_FieldType(0)
		
		If doc.NPS_FieldType(0) = "Text" Then
			DetailReplaceNull(x) = doc.NPS_ReplaceNullText(0)
		Elseif doc.NPS_FieldType(0) = "Number" Then
			DetailReplaceNull(x) = doc.NPS_ReplaceNullNumber(0)
		Elseif doc.NPS_FieldType(0) = "Date" Then
			DetailReplaceNull(x) = doc.NPS_ReplaceNullDate(0)
		End If	
		
		If doc.NPS_FieldType(0) = "Text" Then
			DetailReplaceValue(x) = doc.NPS_ReplaceText(0)
		Elseif doc.NPS_FieldType(0) = "Number" Then
			DetailReplaceValue(x) = doc.NPS_ReplaceNumber(0)
		Elseif doc.NPS_FieldType(0) = "Date" Then
			DetailReplaceValue(x) = doc.NPS_ReplaceDate(0)
		End If
		
		If doc.NPS_FieldType(0) = "Date" Then
			DetailDateFormat(x) = doc.NPS_DateFormat(0)
		Else
			DetailDateFormat(x) = ""
		End If
		
		Set entry = vc.GetNextEntry(entry)
		x = x + 1
		
	Loop Until entry Is Nothing
	
End Function

'**********************************************************************************************