%REM
	Agent MWCSVExport
	Created Nov 18, 2012 by Tripp Black/RCS
	Description: Export agent
%END REM
Option Public
Option Declare
Use "FileHandling"

Sub Initialize
	Dim dvnm As String					' view name of docs to export
	Dim dfnm As String					' form name of docs in lookup
	Dim fpath As String					' export csv filepath including file name
	' customize here
	dvnm = "lupViewName"
	dfnm = "formname"
	fpath = "c:\temp\docsexport.csv"
	' end customizations
	Dim s As New NotesSession
	Dim db As NotesDatabase				' current db
	Dim dForm As NotesForm				' form w/list of fields
	Dim dFldLst As Variant				' list of fields in form dfnm
	Dim dV As NotesView					' lookup view of docs
	Dim dDoc As NotesDocument			' document being exported
	Dim dFld As NotesItem				' field in dDoc being exported
	Dim dfldtxt As String				' field dFld's .Text
	Dim ffilenum As Integer				' file handle to export file
	Dim flinestr As String				' line of text for export file
	Dim dtotal As Double				' counter total
	Dim dcurrent As Double				' counter current

	On Error GoTo SErrorHandler
	
	' setup
	Set db = s.Currentdatabase
	Set dV = db.Getview(dvnm)
	Set dForm = db.Getform(dfnm)
	If (dV Is Nothing) Then
		' abort
		Print "Missing lookup view, " & dvnm & ", in current db. Aborted export."
		Exit Sub
	End If
	If (dForm Is Nothing) Then
		' abort
		Print "Missing form, " & dfnm & ", in current db. Aborted export."
		Exit Sub
	End If
	' get list of fields in form specfied
	dFldLst = dForm.Fields
	' get first doc and confirm something to export
	Set dDoc = dV.Getfirstdocument()
	If (dDoc Is Nothing) Then
		' nothing to do, done
		Print "No documents in view , " & dvnm & "to export (view empty). Done."
		Exit Sub
	End If
	' have document(s) to export, start file export
	ffilenum = FileOpenWrite(fpath)
	If (ffilenum = 0) Then
		' failure starting file
		Print "Unable to start file, " & fpath & ". Aborted export."
		Exit Sub
	End If
	' add labels
	ForAll fldnm In dFldLst
		If (flinestr = "") Then
			' first value
			flinestr = |"| & CStr(fldnm) & |"|
		Else
			' add to list
			flinestr = flinestr & "," & |"| & CStr(fldnm) & |"|
		End If
	End ForAll
	' write label line to csv
	Call FileWriteLine(flinestr, ffilenum)
	flinestr = ""
	dcurrent = 0
	dtotal = CDbl(dV.Entrycount)
	' have file start export looping through docs
	While Not (dDoc Is Nothing)
		' loop through fields and get values from current doc for csv line
		flinestr = ""
		ForAll fldnm In dFldLst
			' start w/empty field and line values
			dfldtxt = ""
			' get current field
			Set dFld = dDoc.Getfirstitem(CStr(fldnm) )
			If (dFld Is Nothing) Then
				' add empty string
			Else
				dfldtxt = ReplaceChar(dFld.Text, |"|, |'|)
			End If
			If (flinestr = "") Then
				' first value
				flinestr = |"| & dfldtxt & |"|
			Else
				' add to list
				flinestr = flinestr & "," & |"| & dfldtxt & |"|
			End If
		End ForAll
		' write label line to csv
		Call FileWriteLine(flinestr, ffilenum)
		' update progress bar
		Print PercentComplete(25, dcurrent, dtotal)
		dcurrent = dcurrent + 1
		' loop
		Set dDoc = dV.GetNextDocument(dDoc)
	Wend
	
	' done close file
	Call FileCloseWrite(ffilenum)
	
	Print "Execution done. Your file is at: " & fpath & "."
SExit:
	Exit Sub	
SErrorHandler:
	Print "(MWCSVExport) Unexpected error: " & CStr(Err) & " " & Error$ & ", line: " & CStr(Erl) & "."
	Resume SExit
End Sub

Script Library: FileHandling

Option Public
Option Declare
Function GetFiles(filepath As String, fileextlist() As String)
	Dim fileName As String			' current filename
	Dim spec As String					' current file extension being processed (e.g. *.* or *.zip)
	Dim listelem As Integer			' ubound of elements list
	Dim counter As Integer			' counter to ubound
	Dim tmpfiles As String			' temporary work folder files
	Dim cmdstr As String				' temporary working string
	Dim successflg As Integer		' process no for shell
	
	On Error Goto FErrorHandler
	
	' loop through file extensions desired
	listelem = Ubound(fileextlist() )
	For counter = 0 To listelem
		spec = fileextlist(counter)
		' add *. prefix
		spec = "*." & spec
		Print "Processing ext: " & spec & " ..."
		
		' get result set (files in current directory) for current type (spec) - e.g. *.*
		fileName = Dir( spec, 15) 
		While fileName <> "" 	
			' *****************************************************************
			' ************************** process file *************************
			' *****************************************************************
			Print "Processing file: " & Cstr(filepath) & "\" & Cstr(fileName)
			
			' add code here ...
			' Call ProcessFile(filepath, fileName)
			
SkipFile:
			' loop to next file
			fileName = Dir
		Wend
	Next counter
	
	' return success
	GetFiles=1
	Exit Function
	
FErrorHandler:
	' error msg to return to user
	Print "(GetFiles) Error - Info: " & Str(Err) & ": " & Error$ & " on line: " & Cstr(Erl)
	
	' return error
	GetFiles=0
	Exit Function
	
End Function

Function FileCloseWrite(filehandlenum As Integer) As Integer
	' closes open file
	Close filehandlenum
	' return success
	FileCloseWrite=1
End Function
Function GetDirectories(inDir As String, fileextlist() As String) As Integer
	Dim basePath As String
	Dim searchSpec As String
	Dim dirName As String
	Dim dirList() As String
	Dim dirCount As Integer
	Dim fileName As String
	Dim stripCount As Integer
	Dim partialPath As String
	
	On Error Goto FErrorHandler
	
	' begin a base path
	basePath=inDir
	Chdir(inDir)
	' loop
	inDir = Curdir() 
	If basePath = "" Then basePath = inDir 
	stripCount = Len(basePath)
	partialPath = Mid (inDir,stripCount + 1)
	
	' log current directory
	Print "(GetDirectories) Working folder: " & Cstr(inDir)
	
	' Trap PATH NOT FOUND errors. 
	On Error 76 Resume Next
	
	dirCount = 0
	If Right(inDir,1) <> "\" Then
		searchSpec = inDir & "\*.*"
	Else
		searchSpec = inDir & "*.*"
	End If
	
	dirName = Dir(searchSpec, 16) 
	Do While dirName <> ""
		If dirName <> "." And dirName <> ".." Then Chdir (dirName)
		If Curdir <> inDir Then
			Chdir("..")
			Redim Preserve dirList (dirCount) 
			dirList (dirCount) = dirName
			dirCount = dirCount + 1
		End If
		dirName = Dir
	Loop
	
	' **************************************************************
	' **********  search for files (using current inDir) **************
	' **************************************************************
	Call GetFiles(inDir, fileextlist)
	
	' recurse down directory tree
	Forall s In dirList
		Call GetDirectories(s, fileextlist)
	End Forall
	
	Chdir ("..")
	
	' return success
	GetDirectories = 1
	Exit Function
	
FErrorHandler:
	' error msg to return to user
	Print "(GetDirectories) Error - Info: " & Str(Err) & ": " & Error$ & " on line: " & Cstr(Erl)
	' return error
	GetDirectories=0
	Exit Function
End Function

Function RunShell(shellpath As String, sleeptime As Integer) As Integer
	' function executes a shell script and sleeps the prescribed number of seconds
	' return 1 for success
	Dim shellstart As Integer
	
	On Error Goto ErrorHandler
	
	' execute shell script/program
	If (shellpath <>"") Then
		shellstart = Shell (shellpath, 1)
	End If
	
	' sleep
	Sleep sleeptime
	
	RunShell=1
	Exit Function
	
ErrorHandler:
	Print "Shell Execution Error: " & Error & " line " & Erl & "(program: " & shellpath & ")."
	RunShell=0
	Exit Function
	
End Function
Function FileWriteLine(linetext As String, filehandlenum As Integer) As Integer
	' writes a data line to file
	Print # filehandlenum, linetext
	FileWriteLine = 1
End Function

Function FileOpenWrite(expfilenm As String) As Integer
	Dim filenum As Integer		' filehandle
	Dim fname As String			' filename/filepath
	
	On Error GoTo FErrorHandler
	
	' setup filepath
	filenum = FreeFile
	fname = expfilenm
	
	' open up new file for write
	Open fname For Output As filenum
	
	' return success as file handle
	FileOpenWrite = filenum
	Exit Function
	
FErrorHandler:
	Print "(FileOpenWrite) Error. Info: " & Str(Err) & ": " & Error$ & " on line: " & CStr(Erl) & "<br>" 
	FileOpenWrite =0
	Exit Function
	
End Function

Function KillFiles(tmpfiles As String) As Integer
	' removes files from a specified directory (full path should be passed for tmpfiles)
	' e.g. pass "c:\temp\" to delete all files in temp directory on drive c
	Dim filekillstr As String				' current file getting killed
	
	On Error Goto FErrorHandler
	On Error 75 Goto FError75Handler
	' do kill
	
	filekillstr = Dir( tmpfiles, 15) 
	While (filekillstr <> "")
		' kill current file
		Kill (tmpfiles & filekillstr)
		' loop to next file
		filekillstr = Dir
	Wend
	
	' return success
	KillFiles=1
	Exit Function
	
FErrorHandler:
	Dim errormsg As String 					' error msg to return to user
	errormsg = "Marker: " & "(KillFiles) Info: " & Str(Err) & ": " & Error$ & " on line: " & Cstr(Erl)
	Print errormsg
	KillFiles=0
	Exit Function
	
FError75Handler:
	Print "(KillFiles) Error: Unable to delete: filekillstr"
	Resume Next
	
End Function

Function PercentComplete(FTGDefault As Integer, FTGCurrent As Double, FTGTotal As Double) As String
%REM
Purpose: Displays a percent complete progress indicator in the status bar.
Not as useful for web printing as each bar would be on a new line.
%END REM
 Dim FTGLength As Integer
 Dim FTGCount As Integer

 PercentComplete = Chr(127)
 FTGLength = (FTGCurrent*FTGDefault)/FTGTotal
 For FTGcount = 2 To FTGDefault + 1
   If FTGCount <= FTGLength + 1 Then
     PercentComplete = PercentComplete + Chr(127)
   Else
     PercentComplete = PercentComplete + "-"
   End If

 Next FTGcount
 PercentComplete = PercentComplete + Chr(127) + " " + CStr(CInt((FTGCurrent/FTGTotal)*100)) + "% Complete"
End Function 

Function ReplaceChar(origstring As String, subchar As String, newchar As String) As String
	Dim szReturn As String ' the modified string to return
	Dim modstring As String ' inprogress modstring
	Dim index As Integer ' working variable showing where subchar is or is not in the origstring
	Dim sublen As Integer ' # of characters length of subchar
	' takes an original string (origstring) and replaces all characters of subchar with newchar
	' returns the modifed (if subchar was found) string back
	' this is modification of the old one stored in the mindwatering support db in that this one supports multiple characters for subchar
	modstring = origstring
	sublen = Len(subchar)
	index = InStr(1, modstring, subchar)
	If sublen = 0 Then
		' we have a nothing subchar so lets just return the original string
		ReplaceChar = origstring
		Exit Function
	End If
	
	If (index = 0) Then
		' subchar was not found in origstring so we can return the original string
		ReplaceChar = origstring
		Exit Function
	End If
	While index <> 0
		szReturn = Left$(modstring, index - 1)
		szReturn = szReturn + newchar + Mid$(modstring, index + sublen)
		modstring = szReturn
		index% = InStr(1, modstring, subchar)
	Wend
	ReplaceChar = szReturn
End Function