Lotus Domino script snippet for Lotus Notes CSV export

This code exports selected/all Notes documents to CSV.

The code can be run manually on selected documents, or scheduled on all documents in the database
EXPORT_StartScheduled, run by a scheduled agent, exports all documents to a CSV file.
EXPORT_CallExportOnClient, exports selected documents to a CSV file on a selected location on the client, client-based.

The fields to be exported are defined in the CSV_MAPPING.
Constants to define in (Declarations):
CSV_MAPPING – define: CSV column header 1; Notes field Name 1; Type | CSV column header 2; Notes field Name 2; Type |… etc.
Type 2 = Integer
Type 3 = Long
Type 7 = Date
Type 8 = String

The view to select Notes documents is defined in constant VIEW_DATABASE_INFO


Option Declare
Option Base 0
Const EXPORT_MAXLINES& = 32000&
Const MESSAGE_SELECT_FOLDER = "Please select a folder"
Const EMPTY_STRING = ""
Const DOUBLE_QUOTE = """"
Const SINGLE_QUOTE = "'"
Const COMMA = ","
Const SEPARATOR1 = "|"
Const SEPARATOR2 = ";"
Const INDEX_CSVTITLE = 0
Const DATE_FORMAT_CSV = "mm/dd/yyyy"
Const FIELDTYPE_FORMULA = 32
Const TMP_TUX = "TMPDIR"
Const TMP_W32 = "TMP"

'Select folder dialog
Const BIF_NEWDIALOGSTYLE = &H00000040

Const CSV_MAPPING = "Key;DbKey;8|Server;DbServer;8|File Path;DbFilePath;8|Title;DbTitle;8|Created;DbCreated;8|" + _
	"Hub;fHubServer;8|Target #;fTargetNumber;2|Target;fTarget;8|Target description;fTargetDescription;8|Manual Target;fSetTargetManual;8|" + _
	"Design strings found;@If(DbDesSearch = """"::""""::""1"");32|# Lines;@Elements(DbDesSearch);32|# To;DbSendToTotal;3|# CC;DbCopyToTotal;3|" + _
	"Replica ID;DbReplicaId;8|Template;DbTemplate;8|DB Size (MB);DbSize;2|Data Docs;DbDataDocs;3|" + _
	"Last Doc Created;DbLastCreatedDateDisp;7|Last Doc Created By;DbLastCreatedBy;8|" + _
	"Last Doc Created Form;DbLastCreatedForm;8|Last Doc Modified;DbLastModifiedDateDisp;7|" + _
	"Last Doc Modified By;DbLastModifiedBy;8|Last Doc Modified Form;DbLastModifiedForm;8|" + _
	"Last Read By;DbLastReadBy;8|Last Read Date;DbLastReadDateDisp;7|Last Write By;DbLastWriteBy;8|" + _
	"Last Write Date;DbLastWriteDateDisp;7|Documents With Readersfield;DbDocsWithReadersField;3|" + _
	"Documents With Authorsfield;DbDocsWithAuthorsField;3|" + _
	"# UA Entries;DbUACount;2|UA Oldest;DbUAFirst;7|UA Newest;DbUALast;7|" + _
	"Year;DbUAYear;2|# Sessions;DbUASessions;3|# Writes;DbUAWrites;3|" + _
	"# Reads;DbUAReads;3|# Unique Users;DbUniqueUsersCnt;2|Users (All);DbUniqueUsers;8200|" + _
	"Users (Recent);DbUniqueUsersSpec;8200|Users (Top);DbUAUser;8200|Docs With Encryption;DbDocsWithEncryption;3|" + _
	"Docs With Children;DbParentsWithChildren;3|Children;DbChildrenWithParents;3|" + _
	"Docs With Doc Link;DbDocsWithDocLink;3|Doc Links;DbAllDocLinks;3|Design Docs;DbDesignDocs;3|" + _
	"Docs With SendTo;DbSendToTotal;3|Forms With SendTo;DbSendToForm;2|Docs With CopyTo;DbCopyToTotal;2|Forms With CopyTo;DbCopyToForm;2|" + _ 
	"Forms Used;DbFormsUsed;2|Form;DbDesForms;2|SubForm;DbDesSubforms;2|View;DbDesViews;2|" + _
	"Agent;DbDesAgents;2|ScriptLibrary;DbDesScriptLibraries;2|Page;DbDesPages;2|Outline;DbDesOutlines;2|" + _
	"Frameset;DbDesFramesets;2|Navigator;DbDesNavigators;2|DatabaseScript;DbDesDatabasescript;2|" + _ 
	"StyleSheet;DbDesStylesheets;2|Folder;DbDesFolders;2|" + _
	"Managers;fACLEntries_6_X;8200|Designers;fACLEntries_5_X;8200|Editors;fACLEntries_4_X;8200|Authors;fACLEntries_3_X;8200|" + _
	"Readers;fACLEntries_2_X;8200|Depositors;fACLEntries_1_X;8200|No Access;fACLEntries_0_X;8200|" + _
	"Status;Status;8|Owner;DbOwner;8|Department;Department;8|Category;Category;8|Complexity;Complexity;8|Type;Type;8|" + _
	"Other;Other;8|Comments;Comments;8|NSF no longer on server;@If(DbRemoved=81::""Removed""::"""");32|" + _
	"Question 1;Questionx[1];32|Answer 1;Answer1a;8|Question 2;Questionx[2];32|Answer 2;Answer2a;8|" + _
	"Question 3;Questionx[3];32|Answer 3;Answer3a;8|Question 4;Questionx[4];32|Answer 4;Answer4a;8|" + _
	"Question 5;Questionx[5];32|Answer 5;Answer5a;8|Question 6;Questionx[6];32|Answer 6;Answer6a;8|" + _
	"Question 7;Questionx[7];32|Answer 7;Answer7a;8|Question 8;Questionx[8];32|Answer 8;Answer8a;8|" + _
	"Question 9;Questionx[9];32|Answer 9;Answer9a;8|Question 10;Questionx[10];32|Answer 10;Answer10a;8"

Const SHELL_APPLICATION = "Shell.Application"
Const ENVIRONMENT_USERPROFILE = "USERPROFILE"
Const ENVIRONMENT_EXPORT_DIALOG = "EXPORT_FOLDER"
Const PATH_SEPARATOR = "\"
Const PATH_SEPARATOR_TUX = "/"
Const EXPORT_NAME = "Export"
Const EXTENTION_CSV = ".csv"
Const EXPORT_FILENAME = "export.csv"
Const WORKBOOK_TITLE = "Export"
Const WORKSHEET_TITLE = "Databases"
Const VIEW_DATABASE_INFO = "Database Info"
Const FIELD_ACTIONSTATUS = "actStatus"
Const MESSAGE_FINISHED_EXPORT = "Finished exporting"
Const COLUMN_COLOUR = 14021119
Const FIXED_ARRAY = 8192
Private Class SpreadsheetWriter	
	Sub New(psFilepath As String)
	End Sub
	
	Public Sub writeEntry(psEntry As String)
	End Sub
	
	Public Sub FormatColumn(iType As Integer)
	End Sub
	
	Public Sub nextRow
	End Sub

	Sub Delete
	End Sub
	
	Public Function isError()
	End Function
End Class
Private Class CSVStreamWriter As SpreadsheetWriter
	Private issnCurrent As NotesSession
	Private ismOut As NotesStream
	
	Private iiColCount As Integer
	
	Sub New(psFilepath As String)
		Set issnCurrent = New NotesSession
		Set ismOut = issnCurrent.createStream
		ismOut.open psFilepath, "UTF-16"
		iiColCount = 0	
	End Sub
	
	Sub writeEntry(psEntry As String)
		If iiColCount <> 0 Then
			ismOut.writeText COMMA
		End If
		ismOut.writeText """" & Replace(psEntry,"""", """""") & """"
		iiColCount = iiColCount + 1
	End Sub
	
	Sub nextRow
		ismOut.writeText EMPTY_STRING, EOL_PLATFORM
		iiColCount = 0
	End Sub
	
	Sub Delete
		ismOut.close
	End Sub
	
End Class
Private Class CSVMapper
	ivMapping As Variant
	
	Sub New
		initializeMapping
	End Sub

	Private Sub initializeMapping	
		Dim lvMapping As Variant
		Dim lvTemp As Variant
		Dim lvValues () As String
		Dim liCount As Integer
		Dim liX As Integer
		On Error GoTo CATCH
		If IsEmpty(lvMapping) Then
			lvMapping = Split(CSV_MAPPING, SEPARATOR1)
		End If
		liCount = UBound(lvMapping) - LBound(lvMapping) + 1
		ReDim lvValues(liCount * 3 - 1)
		For liX = LBound(lvMapping) To UBound(lvMapping)
			lvTemp = Split(lvMapping(liX), SEPARATOR2)
			lvValues(liX * 3) = lvTemp(0)
			lvValues(liX * 3 + 1) = lvTemp(1)
			lvValues(liX * 3 + 2) = lvTemp(2)
		Next
		ivMapping = lvValues
		Exit Sub
CATCH:
		Print formatError("CSVMapper.initializeMapping - %s(%c) at line %l", Erl, Err, Error$)
		Exit Sub
	End Sub

	Public Function getTitle(piPosition As Integer) As String
		If piPosition * 3 > UBound(ivMapping) Or piPosition < 0  Then
			getTitle = ""
			Exit Function
		End If
		getTitle = ivMapping(piPosition * 3)
	End Function
	
	Public Function getMapping(piPosition As Integer) As String
		If piPosition * 3 > UBound(ivMapping) Or piPosition < 0  Then
			getMapping = ""
			Exit Function
		End If
		getMapping = ivMapping(piPosition * 3 + 1)
	End Function

	Public Function getFieldType(piPosition As Integer) As Integer
		If piPosition * 3 > UBound(ivMapping) Or piPosition < 0  Then
			getFieldType = 0
			Exit Function
		End If
		getFieldType = ivMapping(piPosition * 3 + 2)
	End Function

End Class
Private Class StatusBar
	Private ilMaxValue As Long
	Private isText As String
	Private ilStep As Long
	Private ilCount As Long
	
	Private ibOnServer As Boolean
	
	Sub New(psText As String, plMaxValue As Long)
		Dim lssnCurrent As New NotesSession
		
		me.ilMaxValue = plMaxValue
		me.isText = psText
		me.ilCount = 0
		me.ibOnServer = lssnCurrent.isOnServer 
		calculateStep
	End Sub
	
	Private Sub printMessage
		If Not Me.ibOnServer Then
			Print formatMessage()
		End If
	End Sub
	
	Private Sub calculateStep()
		me.ilStep = me.ilMaxValue / 50
		If me.ilStep < 1 Then
			me.ilStep = 1
		ElseIf me.ilStep > 50 Then
			me.ilStep = 50
		End If
	End Sub
	
	Public Sub increment()
		Dim lsMessage As String
		me.ilCount = me.ilCount + 1
		If (me.ilCount Mod me.ilStep) = 0 Then
			printMessage
		End If
	End Sub
	
	Private Function formatMessage()
		Dim liPos1 As Integer
		Dim liPos2 As Integer
		Dim lsMessage As String
		lsMessage = me.isText
		liPos1 = InStr(me.isText, "%s")
		If liPos1 > 0 Then
			lsMessage = Left$(me.isText, liPos1 - 1) & Format$(me.ilCount, "")
			liPos2 = InStr(liPos1 + 2, me.isText, "%s")
			If liPos2 > 0 Then
				lsMessage = lsMessage & Mid$(me.isText, liPos1 + 2, liPos2 - liPos1 - 2) & Format$(me.ilMaxValue, "") & Mid$(me.isText,liPos2 + 2)
			End If	
		End If
		formatMessage = lsMessage
	End Function
End Class
Private Sub EXPORT_writeHeader(pobjWriter As SpreadsheetWriter, pobjMapper As CSVMapper)
	Dim liColumn As Integer
	Dim lsTitle As String
	Dim liType As Integer
	On Error GoTo CATCH
	
	liColumn = 0
	lsTitle = pobjMapper.getTitle(liColumn)
	Do Until Len(lsTitle) = 0
		liType = pobjMapper.getFieldType(liColumn)
		pobjWriter.FormatColumn(liType)
		pobjWriter.writeEntry lsTitle

		liColumn = liColumn + 1
		lsTitle = pobjMapper.getTitle(liColumn)
	Loop
	pobjWriter.nextRow
	Exit Sub
CATCH:
	Print formatError("EXPORT_writeheader - %s(%c) at line %l", Erl, Err, Error$)
	Exit Sub
End Sub
Private Sub EXPORT_createExportDocument(pdbCurrent As NotesDatabase, psFilename As String)
	Dim ldocExport As NotesDocument
	Dim lrtAttachment As NotesRichTextItem
	
	Set ldocExport = pdbCurrent.Createdocument()
	ldocExport.replaceItemValue "Form", "fmExport"
	ldocExport.replaceItemValue "View", "Database Info"
	
	Set lrtAttachment = ldocExport.Createrichtextitem("fAttachment")
	lrtAttachment.Embedobject EMBED_ATTACHMENT, "", psFilename, psFilename
	ldocExport.Computewithform False, False	
	ldocExport.save True, True  
End Sub
Private Sub EXPORT_AllToCSV(pobjWriter As SpreadsheetWriter, lsView As String)
	Dim liFile As Integer
	Dim liX As Integer
	Dim lsTitle As String
	Dim lobjMapper As CSVMapper
	
	On Error GoTo CATCH
	
	Set lobjMapper = New CSVMapper()
	
	EXPORT_writeHeader pobjWriter, lobjMapper
	EXPORT_processDatabaseInfo pobjWriter, lsView, lobjMapper
	
	Exit Sub
CATCH:
	Print formatError("ExportALLToCSV - %s(%c) at line %l", Erl, Err, Error$)
	Exit Sub
End Sub
Private Sub EXPORT_exportView(pvwExport As NotesView, pobjWriter As SpreadsheetWriter, pobjMapper As CSVMapper)
	Dim lvcUnprocessed As NotesViewEntryCollection
	Dim lvwe As NotesViewEntry
	Dim ldocProcess As NotesDocument
	Dim lStatus As StatusBar
	On Error GoTo CATCH
	pvwExport.autoUpdate = False
	'Export view entry collection
	Set lvcUnprocessed = pvwExport.Allentries
	Set lStatus = New StatusBar("Exporting to csv %s/%s", lvcUnprocessed.count)
	Set lvwe = lvcUnprocessed.Getfirstentry()
	Do Until lvwe Is Nothing
		Set ldocProcess = lvwe.document
		If Not ldocProcess Is Nothing Then
			EXPORT_processDocument ldocProcess, pobjWriter, pobjMapper
		End If
		Set lvwe = lvcUnprocessed.getNextEntry(lvwe)
		lStatus.increment
	Loop
	pvwExport.autoUpdate = True
	Exit Sub
CATCH:
	Print formatError("ExportView - %s(%c) at line %l", Erl, Err, Error$)
	Exit Sub
End Sub
Private Function ValueToString(pvValue As Variant) As String
	Dim liX As Integer
	Dim lsReturn As String

	On Error GoTo CATCH:
	
	If IsArray(pvValue) Then
		lsReturn = ValueToString(pvValue(LBound(pvValue)))	
		If Not UBound(pvValue) - LBound(pvValue) < 1 Then 
			For liX = LBound(pvValue) + 1 To UBound(pvValue)
				lsReturn = lsReturn & ";" & ValueToString((pvValue(liX)))
			Next
		End If
	Else
		Select Case DataType(pvValue):
		Case 2: 'V_INTEGER
			lsReturn = Format$(pvValue, EMPTY_STRING) 
		Case 7: 'V_DATE
			lsReturn = Format$(pvValue, DATE_FORMAT_CSV)
		Case 32: ' FORMULA!
			
		Case Else:
			lsReturn = CStr(pvValue)
		End Select 
	End If
	ValueToString = lsReturn
	Exit Function
CATCH:
	
	Print formatError("ValueToString: %s(%c) at line %l", Erl, Err, Error$)
	Exit Function
End Function
Private Sub EXPORT_processDocument(pdocProcess As NotesDocument, pobjWriter As SpreadsheetWriter,  pobjMapper As CSVMapper)
	Dim liColumn As Integer
	Dim lsFieldName As String
	Dim lsValue As String
	Dim liFieldType As Integer
	On Error GoTo CATCH
	liColumn = 0
	
	lsFieldname = pobjMapper.getMapping(liColumn)	
	Do Until Len(lsFieldname) = 0
		liFieldType = pobjMapper.getFieldType(liColumn)
		If liFieldType = FIELDTYPE_FORMULA Then
			lsValue = calculateFormula(pdocProcess, lsFieldname)
		Else
			If (lsFieldName = "DbUAReads" Or lsFieldName = "DbUAWrites") Then
				lsValue = ValueToString(pdocProcess.getItemValue(lsFieldname)(0))
			Else
				lsValue = ValueToString(pdocProcess.getItemValue(lsFieldname))
			End If
		End If
		pobjWriter.writeEntry lsValue
		
		liColumn = liColumn + 1
		lsFieldname = pobjMapper.getMapping(liColumn)
	Loop
	pobjWriter.nextRow
	Exit Sub
CATCH:
	Print formatError("ProcessDocument: %l: %s", Erl, Err, Error$)
	Exit Sub
End Sub
Private Function getSaveFolder As String
	Dim lssnCurrent As New NotesSession
	Dim lsFolder As String
	
	Dim lsPlatform As String
	lsPlatform = lssnCurrent.Platform
	
	lsFolder = Environ$(ENVIRONMENT_USERPROFILE)
	If Left$(lsPlatform, 7) = "Windows" Then
		If Right$(lsFolder, 1) <> PATH_SEPARATOR Then
			lsFolder = lsFolder & PATH_SEPARATOR
		End If	
		lsFolder = lsFolder & "Documents" & PATH_SEPARATOR
	ElseIf Right$(lsFolder, 1) <> PATH_SEPARATOR_TUX Then
		lsFolder = lsFolder & PATH_SEPARATOR_TUX
	End If
	getSaveFolder = lsFolder
End Function
Private Function formatError(psMessage As String, piErrorline As Integer, piErrorCode As Integer, psErrorString As String) As String
	Dim liPos As Integer
	Dim lsMessage As String
	lsMessage = psMessage
	liPos = InStr(lsMessage, "%l")
	If liPos >= 0 Then
		lsMessage = Left$(lsMessage, liPos - 1) & Format$(piErrorline, "") & Mid$(lsMessage, liPos + 2)
	End If
	liPos = InStr(lsMessage, "%c")
	If liPos >= 0 Then
		lsMessage = Left$(lsMessage, liPos - 1) & Format$(piErrorCode, "") & Mid$(lsMessage, liPos + 2)
	End If
	liPos = InStr(lsMessage, "%s")
	If liPos >= 0 Then
		lsMessage = Left$(lsMessage, liPos - 1) & psErrorString & Mid$(lsMessage, liPos + 2)
	End If
	formatError = lsMessage
End Function
Private Function folderDialog(psFolder As String) As String
	Dim lShell As Variant
	Dim lFolder As Variant
	Dim lFolderItem As Variant
	Set lShell = CreateObject(SHELL_APPLICATION)
	Set lFolder = lShell.BrowseForFolder(0, MESSAGE_SELECT_FOLDER, BIF_NEWDIALOGSTYLE, psFolder)
	If Not (lFolder Is Nothing) Then
		Set lFolderItem = lFolder.Self
		folderDialog = lFolderItem.Path
	Else
		folderDialog = "" 
	End If
End Function
Public Sub EXPORT_StartScheduled
	'run by scheduled agent
	Dim lssnCurrent As New NotesSession
	Dim ldbCurrent As NotesDatabase
	Dim lvwActions As NotesView
	Dim ldocAction As NotesDocument
	Dim lobjWriter As SpreadsheetWriter
	
	Dim lsView As String
	Dim lsFolder As String
	Dim lsFilepath As String
	Dim lsError As String
	
	On Error GoTo CATCH
	
	Print "Export started"

	lsFolder = getTempFolder()
	lsFilepath = lsFolder & EXPORT_FILENAME
	If Len(Dir$(lsFilepath)) <> 0 Then
		Kill lsFilepath
	End If
			
	Set lobjWriter = New CSVStreamWriter(lsFilepath)
	EXPORT_AllToCSV lobjWriter, VIEW_DATABASE_INFO
	Delete lobjWriter
	EXPORT_createExportDocuments ldbCurrent, lsFilepath
			
	Kill lsFilepath

	Print MESSAGE_FINISHED_EXPORT
	Exit Sub
CATCH:
	Print formatError("EXPORT_StartScheduled - %s(%c) at line %l", Erl, Err, Error$)
	Exit Sub		
End Sub
Private Sub EXPORT_processDatabaseInfo(pobjWriter As SpreadsheetWriter, psView As String, pobjMapper As CSVMapper)
	Dim lssnCurrent As New NotesSession
	Dim ldbCurrent As NotesDatabase
	Dim lvwExport As NotesView
	Dim ldcUnprocessed As NotesDocumentCollection

	Set ldbCurrent = lssnCurrent.Currentdatabase
	
	On Error GoTo CATCH
	
	If Len(psView) <> 0 Then
		Set lvwExport = ldbCurrent.getView(psView)
		If Not lvwExport Is Nothing Then
			EXPORT_exportView lvwExport, pobjWriter, pobjMapper
			Exit Sub
		End If
	End If
	Set ldcUnprocessed = ldbCurrent.UnprocessedDocuments
	If ldcUnprocessed.count = 0 Then
		Set ldcUnprocessed = ldbCurrent.Alldocuments
	End If
	EXPORT_ExportDocuments ldcUnprocessed, pobjWriter, pobjMapper
	Exit Sub
CATCH:
	Print formatError("ProcessDatabaseInfo: %l: %s", Erl, Err, Error$)
	Exit Sub
End Sub
Private Function StringToValue(psString As String, piType As Integer) As Variant
	Dim lvValue As Variant
	Dim liX As Integer
	On Error GoTo CATCH
	If (piType And FIXED_ARRAY) <> 0 Then ' Fixed Array 
		lvValue = Split(psString, ";")
		For liX = LBound(lvValue) To UBound(lvValue)
			lvValue(liX) = StringToValue(lvValue(liX), piType Xor FIXED_ARRAY)
		Next
	Else
		Select Case piType:
		Case 2: 'V_INTEGER
			lvValue = CInt(psString)
		Case 3: 'V_LONG
			lvValue = CLng(psString)
		Case 7: 'V_DATE
			lvValue = CDat(psString)
		Case 8: 'V_STRING
			lvValue = psString
		Case Else:
			lvValue = psString
		End Select 
	End If
	GoTo FINALLY
CATCH:
	Print "Error"
	Resume FINALLY
FINALLY:
	On Error GoTo 0
	StringToValue = lvValue
End Function
Private Sub EXPORT_createExportDocuments(pdbCurrent As NotesDatabase, psFilename As String)
	Dim lssnCurrent As New NotesSession
	Dim lsmIn As NotesStream
	Dim lsmOut As NotesStream
	Dim lsHeaders As String
	Dim lsLine As String
	Dim llLineNumber As Long
	Dim lsNumberedFilename As String
	Dim liNumber As Integer
	Set lsmIn = lssnCurrent.createStream()
	Set lsmOut = lssnCurrent.createStream()
	
	lsmIn.open psFilename, "UTF-16"
	
	lsHeaders = lsmIn.readText(STMREAD_LINE, EOL_PLATFORM)
	liNumber = 0
	llLineNumber = 0
	lsNumberedFilename = FUNCTIONS_adjustFilenumber(psFilename, liNumber) 
	lsmOut.open lsNumberedFilename, "UTF-16"
	lsmOut.Writetext lsHeaders, EOL_NONE 'no need to wrte EOL, it's already included in line
	Do Until False
		lsLine = lsmIn.Readtext(STMREAD_LINE, EOL_PLATFORM)
		If Len(lsLine) = 0 Then
			Exit Do
		End If
		lsmOut.writeText lsLine, EOL_NONE
		llLineNumber = llLinenumber + 1
		If llLinenumber >= EXPORT_MAXLINES Then
			lsmOut.Close
			EXPORT_createExportDocument pdbCurrent, lsNumberedFilename
			Kill lsNumberedFilename
			llLineNumber = 0
			liNumber = liNumber + 1
			lsNumberedFilename = FUNCTIONS_adjustFilenumber(psFilename, liNumber)
			lsmOut.open lsNumberedFilename, "UTF-16"
			lsmOut.Writetext lsHeaders, EOL_NONE
		End If 
	Loop
	lsmOut.close
	If llLinenumber > 0& Then
		EXPORT_createExportDocument pdbCurrent, lsNumberedFilename
		Kill lsNumberedFilename
	ElseIf Len(Dir$(lsNumberedFilename)) <> 0 Then
		Kill lsNumberedFilename
	End If
	lsmIn.close
End Sub
Private Function FUNCTIONS_adjustFilenumber(psFilenameIn As String, piNumber As Integer) As String
	Dim liX As Integer
	
	liX = InStr(psFilenameIn, ".")
	FUNCTIONS_adjustFilenumber = Left$(psFilenameIn, liX - 1) & "_" & Format$(piNumber, "000") & Mid$(psFilenameIn, liX)
End Function
Private Sub EXPORT_ExportDocuments(pdcUnprocessed As NotesDocumentCollection, pobjWriter As SpreadsheetWriter, pobjMapper As CSVMapper)
	Dim ldocProcess As NotesDocument
	Dim lStatus As StatusBar
	
	On Error GoTo CATCH
	
	'Export document collection
	Set lStatus = New StatusBar("Exporting to csv %s/%s", pdcUnprocessed.count)
	Set ldocProcess = pdcUnprocessed.getFirstDocument()

	Do Until ldocProcess Is Nothing
		If ldocProcess.getItemValue("Form")(0) = "DbInfo" Then
			EXPORT_processDocument ldocProcess, pobjWriter, pobjMapper 
		End If
		Set ldocProcess = pdcUnprocessed.getNextDocument(ldocProcess)
		lStatus.increment
	Loop
	Exit Sub
CATCH:
	Print formatError("ExportDocuments - %s(%c) at line %l", Erl, Err, Error$)
	Exit Sub
End Sub
Private Function getConditionDateString(psCondition As String) As String
	If psCondition ="0" Then
		getConditionDateString = "before"
	Else
		getConditionDateString = "after"
	End If
End Function
Private Function calculateFormula(pdocSource As NotesDocument, pvValue As Variant)
	Dim lvResult As Variant
	Dim liPos As Integer
	Dim lsFormula As String
	
	lsFormula = pvValue
	'replace the :: markers by a ;
	liPos = InStr(lsFormula, "::")
	While liPos > 0 
		lsFormula = Left$(lsFormula, liPos - 1) & ";" & Mid$(lsFormula, liPos + 2)  
		liPos = InStr(liPos, lsFormula, "::")	
	Wend
	On Error GoTo CATCH
	lvResult = Evaluate(lsFormula, pdocSource)
	If IsArray(lvResult) Then
		calculateFormula = CStr(lvResult(0))
	Else
	 	lvResult = ""
	End If
	
	Exit Function
CATCH:
	Print formatError("calculateFormula: %s(%c) at Line %l", Erl, Err, Error$)
	Exit Function
	
End Function
Private Function getTempFolder() As String
	Dim lssnCurrent As New NotesSession
	Dim lsFolder As String
	Dim lvValue As Variant
	
	Dim lsPlatform As String
	lsPlatform = lssnCurrent.Platform
	If Left$(lsPlatform, 7) = "Windows" Then
		lsFolder = Environ$(TMP_W32)
		If lsFolder = "" Then
			lsFolder = "C:\Temp\"
		End If
		If Right$(lsFolder, 1) <> "\" Then
			lsFolder = lsFolder & "\"
		End If
	Else 'assume POSIX compliant systen
		lsFolder = Environ$(TMP_TUX)
		If lsFolder = "" Then
			lsFolder = "/tmp/"
		End If
		If Right$(lsFolder, 1) <> "/" Then
			lsFolder = lsFolder & "/"
		End If
	End If
	lssnCurrent.SetEnvironmentVar ENVIRONMENT_EXPORT_DIALOG, lvValue, False

	getTempFolder = lsFolder
End Function
Public Sub EXPORT_CallExportOnClient
	Dim lwsCurrent As New NotesUIWorkspace
	Dim lsFilePath As String
	Dim lsFolder As String
	Dim lobjWriter As SpreadsheetWriter
	
	lsFolder = getSaveFolder()
	If Len(lsFolder) = 0 Then
		Exit Sub
	End If

	lsFolder = folderDialog(lsFolder)
	If lsFolder <> "" Then
		lsFilepath = lsFolder & "\" & EXPORT_NAME & EXTENTION_CSV
		If Len(Dir$(lsFilepath)) <> 0 Then
			Kill lsFilepath
		End If
		
		Set lobjWriter = New CSVStreamWriter(lsFilepath)
		EXPORT_AllToCSV lobjWriter, ""
		Print "Export to " & lsFilepath & " completed."		
	Else
		Print "Export canceled"
	End If
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

455

456

457

458

459

460

461

462

463

464

465

466

467

468

469

470

471

472

473

474

475

476

477

478

479

480

481

482

483

484

485

486

487

488

489

490

491

492

493

494

495

496

497

498

499

500

501

502

503

504

505

506

507

508

509

510

511

512

513

514

515

516

517

518

519

520

521

522

523

524

525

526

527

528

529

530

531

532

533

534

535

536

537

538

539

540

541

542

543

544

545

546

547

548

549

550

551

552

553

554

555

556

557

558

559

560

561

562

563

564

565

566

567

568

569

570

571

572

573

574

575

576

577

578

579

580

581

582

583

584

585

586

587

588

589

590

591

592

593

594

595

596

597

598

599

600

601

602

603

604

605

606

607

608

609

610

611

612

613

614

615

616

617

618

619

620

621

622

623

624

625

626

627

628

629

630

631

632

633

634

635

636

637

638

639

640

641

642

643

644

645

646

647

648

649

650

651

652

653

654

655

656

657

658

659

660

661

662

663

664

665

666

667

668

669

670

671

672

673

674

675

676

677

Option Declare

Option Base 0

Const EXPORT_MAXLINES& = 32000&

Const MESSAGE_SELECT_FOLDER = "Please select a folder"

Const EMPTY_STRING = ""

Const DOUBLE_QUOTE = """"

Const SINGLE_QUOTE = "'"

Const COMMA = ","

Const SEPARATOR1 = "|"

Const SEPARATOR2 = ";"

Const INDEX_CSVTITLE = 0

Const DATE_FORMAT_CSV = "mm/dd/yyyy"

Const FIELDTYPE_FORMULA = 32

Const TMP_TUX = "TMPDIR"

Const TMP_W32 = "TMP"

'Select folder dialog

Const BIF_NEWDIALOGSTYLE = &H00000040

"Design strings found;@If(DbDesSearch = """"::""""::""1"");32|# Lines;@Elements(DbDesSearch);32|# To;DbSendToTotal;3|# CC;DbCopyToTotal;3|" + _

"Replica ID;DbReplicaId;8|Template;DbTemplate;8|DB Size (MB);DbSize;2|Data Docs;DbDataDocs;3|" + _

"Last Doc Created;DbLastCreatedDateDisp;7|Last Doc Created By;DbLastCreatedBy;8|" + _

"Last Doc Created Form;DbLastCreatedForm;8|Last Doc Modified;DbLastModifiedDateDisp;7|" + _

"Last Doc Modified By;DbLastModifiedBy;8|Last Doc Modified Form;DbLastModifiedForm;8|" + _

"Last Read By;DbLastReadBy;8|Last Read Date;DbLastReadDateDisp;7|Last Write By;DbLastWriteBy;8|" + _

"Last Write Date;DbLastWriteDateDisp;7|Documents With Readersfield;DbDocsWithReadersField;3|" + _

"Documents With Authorsfield;DbDocsWithAuthorsField;3|" + _

"# UA Entries;DbUACount;2|UA Oldest;DbUAFirst;7|UA Newest;DbUALast;7|" + _

"Year;DbUAYear;2|# Sessions;DbUASessions;3|# Writes;DbUAWrites;3|" + _

"# Reads;DbUAReads;3|# Unique Users;DbUniqueUsersCnt;2|Users (All);DbUniqueUsers;8200|" + _

"Users (Recent);DbUniqueUsersSpec;8200|Users (Top);DbUAUser;8200|Docs With Encryption;DbDocsWithEncryption;3|" + _

"Docs With Children;DbParentsWithChildren;3|Children;DbChildrenWithParents;3|" + _

"Docs With Doc Link;DbDocsWithDocLink;3|Doc Links;DbAllDocLinks;3|Design Docs;DbDesignDocs;3|" + _

"Docs With SendTo;DbSendToTotal;3|Forms With SendTo;DbSendToForm;2|Docs With CopyTo;DbCopyToTotal;2|Forms With CopyTo;DbCopyToForm;2|" + _

"Forms Used;DbFormsUsed;2|Form;DbDesForms;2|SubForm;DbDesSubforms;2|View;DbDesViews;2|" + _

"Agent;DbDesAgents;2|ScriptLibrary;DbDesScriptLibraries;2|Page;DbDesPages;2|Outline;DbDesOutlines;2|" + _

"Frameset;DbDesFramesets;2|Navigator;DbDesNavigators;2|DatabaseScript;DbDesDatabasescript;2|" + _

"StyleSheet;DbDesStylesheets;2|Folder;DbDesFolders;2|" + _

"Managers;fACLEntries_6_X;8200|Designers;fACLEntries_5_X;8200|Editors;fACLEntries_4_X;8200|Authors;fACLEntries_3_X;8200|" + _

"Readers;fACLEntries_2_X;8200|Depositors;fACLEntries_1_X;8200|No Access;fACLEntries_0_X;8200|" + _

"Other;Other;8|Comments;Comments;8|NSF no longer on server;@If(DbRemoved=81::""Removed""::"""");32|" + _

"Question 1;Questionx[1];32|Answer 1;Answer1a;8|Question 2;Questionx[2];32|Answer 2;Answer2a;8|" + _

"Question 3;Questionx[3];32|Answer 3;Answer3a;8|Question 4;Questionx[4];32|Answer 4;Answer4a;8|" + _

"Question 5;Questionx[5];32|Answer 5;Answer5a;8|Question 6;Questionx[6];32|Answer 6;Answer6a;8|" + _

"Question 7;Questionx[7];32|Answer 7;Answer7a;8|Question 8;Questionx[8];32|Answer 8;Answer8a;8|" + _

"Question 9;Questionx[9];32|Answer 9;Answer9a;8|Question 10;Questionx[10];32|Answer 10;Answer10a;8"

Const SHELL_APPLICATION = "Shell.Application"

Const ENVIRONMENT_USERPROFILE = "USERPROFILE"

Const ENVIRONMENT_EXPORT_DIALOG = "EXPORT_FOLDER"

Const PATH_SEPARATOR = "\"

Const PATH_SEPARATOR_TUX = "/"

Const EXPORT_NAME = "Export"

Const EXTENTION_CSV = ".csv"

Const EXPORT_FILENAME = "export.csv"

Const WORKBOOK_TITLE = "Export"

Const WORKSHEET_TITLE = "Databases"

Const VIEW_DATABASE_INFO = "Database Info"

Const FIELD_ACTIONSTATUS = "actStatus"

Const MESSAGE_FINISHED_EXPORT = "Finished exporting"

Const COLUMN_COLOUR = 14021119

Const FIXED_ARRAY = 8192

Private Class SpreadsheetWriter

Sub New(psFilepath As String)

End Sub

Public Sub writeEntry(psEntry As String)

End Sub

Public Sub FormatColumn(iType As Integer)

End Sub

Public Sub nextRow

End Sub

Sub Delete

End Sub

Public Function isError()

End Function

End Class

Private Class CSVStreamWriter As SpreadsheetWriter

Private issnCurrent As NotesSession

Private ismOut As NotesStream

Private iiColCount As Integer

Sub New(psFilepath As String)

Set issnCurrent = New NotesSession

Set ismOut = issnCurrent.createStream

ismOut.open psFilepath, "UTF-16"

iiColCount = 0

End Sub

Sub writeEntry(psEntry As String)

If iiColCount <> 0 Then

ismOut.writeText COMMA

End If

ismOut.writeText """" & Replace(psEntry,"""", """""") & """"

iiColCount = iiColCount + 1

End Sub

Sub nextRow

ismOut.writeText EMPTY_STRING, EOL_PLATFORM

iiColCount = 0

End Sub

Sub Delete

ismOut.close

End Sub

End Class

Private Class CSVMapper

ivMapping As Variant

Sub New

initializeMapping

End Sub

Private Sub initializeMapping

Dim lvMapping As Variant

Dim lvTemp As Variant

Dim lvValues () As String

Dim liCount As Integer

Dim liX As Integer

On Error GoTo CATCH

If IsEmpty(lvMapping) Then

lvMapping = Split(CSV_MAPPING, SEPARATOR1)

End If

liCount = UBound(lvMapping) - LBound(lvMapping) + 1

ReDim lvValues(liCount * 3 - 1)

For liX = LBound(lvMapping) To UBound(lvMapping)

lvTemp = Split(lvMapping(liX), SEPARATOR2)

lvValues(liX * 3) = lvTemp(0)

lvValues(liX * 3 + 1) = lvTemp(1)

lvValues(liX * 3 + 2) = lvTemp(2)

ivMapping = lvValues

Exit Sub

CATCH:

Print formatError("CSVMapper.initializeMapping - %s(%c) at line %l", Erl, Err, Error$)

Exit Sub

End Sub

Public Function getTitle(piPosition As Integer) As String

If piPosition * 3 > UBound(ivMapping) Or piPosition < 0 Then

getTitle = ""

Exit Function

End If

getTitle = ivMapping(piPosition * 3)

End Function

Public Function getMapping(piPosition As Integer) As String

If piPosition * 3 > UBound(ivMapping) Or piPosition < 0 Then

getMapping = ""

Exit Function

End If

getMapping = ivMapping(piPosition * 3 + 1)

End Function

Public Function getFieldType(piPosition As Integer) As Integer

If piPosition * 3 > UBound(ivMapping) Or piPosition < 0 Then

getFieldType = 0

Exit Function

End If

getFieldType = ivMapping(piPosition * 3 + 2)

End Function

End Class

Private Class StatusBar

Private ilMaxValue As Long

Private isText As String

Private ilStep As Long

Private ilCount As Long

Private ibOnServer As Boolean

Sub New(psText As String, plMaxValue As Long)

Dim lssnCurrent As New NotesSession

me.ilMaxValue = plMaxValue

me.isText = psText

me.ilCount = 0

me.ibOnServer = lssnCurrent.isOnServer

calculateStep

End Sub

Private Sub printMessage

If Not Me.ibOnServer Then

Print formatMessage()

End If

End Sub

Private Sub calculateStep()

me.ilStep = me.ilMaxValue / 50

If me.ilStep < 1 Then

me.ilStep = 1

ElseIf me.ilStep > 50 Then

me.ilStep = 50

End If

End Sub

Public Sub increment()

Dim lsMessage As String

me.ilCount = me.ilCount + 1

If (me.ilCount Mod me.ilStep) = 0 Then

printMessage

End If

End Sub

Private Function formatMessage()

Dim liPos1 As Integer

Dim liPos2 As Integer

Dim lsMessage As String

lsMessage = me.isText

liPos1 = InStr(me.isText, "%s")

If liPos1 > 0 Then

lsMessage = Left$(me.isText, liPos1 - 1) & Format$(me.ilCount, "")

liPos2 = InStr(liPos1 + 2, me.isText, "%s")

If liPos2 > 0 Then

lsMessage = lsMessage & Mid$(me.isText, liPos1 + 2, liPos2 - liPos1 - 2) & Format$(me.ilMaxValue, "") & Mid$(me.isText,liPos2 + 2)

End If

formatMessage = lsMessage

End Function

End Class

Private Sub EXPORT_writeHeader(pobjWriter As SpreadsheetWriter, pobjMapper As CSVMapper)

Dim liColumn As Integer

Dim lsTitle As String

Dim liType As Integer

On Error GoTo CATCH

liColumn = 0

lsTitle = pobjMapper.getTitle(liColumn)

Do Until Len(lsTitle) = 0

liType = pobjMapper.getFieldType(liColumn)

pobjWriter.FormatColumn(liType)

pobjWriter.writeEntry lsTitle

liColumn = liColumn + 1

lsTitle = pobjMapper.getTitle(liColumn)

Loop

pobjWriter.nextRow

Exit Sub

CATCH:

Print formatError("EXPORT_writeheader - %s(%c) at line %l", Erl, Err, Error$)

Exit Sub

End Sub

Private Sub EXPORT_createExportDocument(pdbCurrent As NotesDatabase, psFilename As String)

Dim ldocExport As NotesDocument

Dim lrtAttachment As NotesRichTextItem

Set ldocExport = pdbCurrent.Createdocument()

ldocExport.replaceItemValue "Form", "fmExport"

ldocExport.replaceItemValue "View", "Database Info"

Set lrtAttachment = ldocExport.Createrichtextitem("fAttachment")

lrtAttachment.Embedobject EMBED_ATTACHMENT, "", psFilename, psFilename

ldocExport.Computewithform False, False

ldocExport.save True, True

End Sub

Private Sub EXPORT_AllToCSV(pobjWriter As SpreadsheetWriter, lsView As String)

Dim liFile As Integer

Dim liX As Integer

Dim lsTitle As String

Dim lobjMapper As CSVMapper

On Error GoTo CATCH

Set lobjMapper = New CSVMapper()

EXPORT_writeHeader pobjWriter, lobjMapper

EXPORT_processDatabaseInfo pobjWriter, lsView, lobjMapper

Exit Sub

CATCH:

Print formatError("ExportALLToCSV - %s(%c) at line %l", Erl, Err, Error$)

Exit Sub

End Sub

Private Sub EXPORT_exportView(pvwExport As NotesView, pobjWriter As SpreadsheetWriter, pobjMapper As CSVMapper)

Dim lvcUnprocessed As NotesViewEntryCollection

Dim lvwe As NotesViewEntry

Dim ldocProcess As NotesDocument

Dim lStatus As StatusBar

On Error GoTo CATCH

pvwExport.autoUpdate = False

'Export view entry collection

Set lvcUnprocessed = pvwExport.Allentries

Set lStatus = New StatusBar("Exporting to csv %s/%s", lvcUnprocessed.count)

Set lvwe = lvcUnprocessed.Getfirstentry()

Do Until lvwe Is Nothing

Set ldocProcess = lvwe.document

If Not ldocProcess Is Nothing Then

EXPORT_processDocument ldocProcess, pobjWriter, pobjMapper

End If

Set lvwe = lvcUnprocessed.getNextEntry(lvwe)

lStatus.increment

Loop

pvwExport.autoUpdate = True

Exit Sub

CATCH:

Print formatError("ExportView - %s(%c) at line %l", Erl, Err, Error$)

Exit Sub

End Sub

Private Function ValueToString(pvValue As Variant) As String

Dim liX As Integer

Dim lsReturn As String

On Error GoTo CATCH:

If IsArray(pvValue) Then

lsReturn = ValueToString(pvValue(LBound(pvValue)))

If Not UBound(pvValue) - LBound(pvValue) < 1 Then

For liX = LBound(pvValue) + 1 To UBound(pvValue)

lsReturn = lsReturn & ";" & ValueToString((pvValue(liX)))

End If

Else

Select Case DataType(pvValue):

Case 2: 'V_INTEGER

lsReturn = Format$(pvValue, EMPTY_STRING)

Case 7: 'V_DATE

lsReturn = Format$(pvValue, DATE_FORMAT_CSV)

Case 32: ' FORMULA!

Case Else:

lsReturn = CStr(pvValue)

End Select

End If

ValueToString = lsReturn

Exit Function

CATCH:

Print formatError("ValueToString: %s(%c) at line %l", Erl, Err, Error$)

Exit Function

End Function

Private Sub EXPORT_processDocument(pdocProcess As NotesDocument, pobjWriter As SpreadsheetWriter, pobjMapper As CSVMapper)

Dim liColumn As Integer

Dim lsFieldName As String

Dim lsValue As String

Dim liFieldType As Integer

On Error GoTo CATCH

liColumn = 0

lsFieldname = pobjMapper.getMapping(liColumn)

Do Until Len(lsFieldname) = 0

liFieldType = pobjMapper.getFieldType(liColumn)

If liFieldType = FIELDTYPE_FORMULA Then

lsValue = calculateFormula(pdocProcess, lsFieldname)

Else

If (lsFieldName = "DbUAReads" Or lsFieldName = "DbUAWrites") Then

lsValue = ValueToString(pdocProcess.getItemValue(lsFieldname)(0))

Else

lsValue = ValueToString(pdocProcess.getItemValue(lsFieldname))

End If

pobjWriter.writeEntry lsValue

liColumn = liColumn + 1

lsFieldname = pobjMapper.getMapping(liColumn)

Loop

pobjWriter.nextRow

Exit Sub

CATCH:

Print formatError("ProcessDocument: %l: %s", Erl, Err, Error$)

Exit Sub

End Sub

Private Function getSaveFolder As String

Dim lssnCurrent As New NotesSession

Dim lsFolder As String

Dim lsPlatform As String

lsPlatform = lssnCurrent.Platform

lsFolder = Environ$(ENVIRONMENT_USERPROFILE)

If Left$(lsPlatform, 7) = "Windows" Then

If Right$(lsFolder, 1) <> PATH_SEPARATOR Then

lsFolder = lsFolder & PATH_SEPARATOR

End If

lsFolder = lsFolder & "Documents" & PATH_SEPARATOR

ElseIf Right$(lsFolder, 1) <> PATH_SEPARATOR_TUX Then

lsFolder = lsFolder & PATH_SEPARATOR_TUX

End If

getSaveFolder = lsFolder

End Function

Private Function formatError(psMessage As String, piErrorline As Integer, piErrorCode As Integer, psErrorString As String) As String

Dim liPos As Integer

Dim lsMessage As String

lsMessage = psMessage

liPos = InStr(lsMessage, "%l")

If liPos >= 0 Then

lsMessage = Left$(lsMessage, liPos - 1) & Format$(piErrorline, "") & Mid$(lsMessage, liPos + 2)

End If

liPos = InStr(lsMessage, "%c")

If liPos >= 0 Then

lsMessage = Left$(lsMessage, liPos - 1) & Format$(piErrorCode, "") & Mid$(lsMessage, liPos + 2)

End If

liPos = InStr(lsMessage, "%s")

If liPos >= 0 Then

lsMessage = Left$(lsMessage, liPos - 1) & psErrorString & Mid$(lsMessage, liPos + 2)

End If

formatError = lsMessage

End Function

Private Function folderDialog(psFolder As String) As String

Dim lShell As Variant

Dim lFolder As Variant

Dim lFolderItem As Variant

Set lShell = CreateObject(SHELL_APPLICATION)

Set lFolder = lShell.BrowseForFolder(0, MESSAGE_SELECT_FOLDER, BIF_NEWDIALOGSTYLE, psFolder)

If Not (lFolder Is Nothing) Then

Set lFolderItem = lFolder.Self

folderDialog = lFolderItem.Path

Else

folderDialog = ""

End If

End Function

Public Sub EXPORT_StartScheduled

'run by scheduled agent

Dim lssnCurrent As New NotesSession

Dim ldbCurrent As NotesDatabase

Dim lvwActions As NotesView

Dim ldocAction As NotesDocument

Dim lobjWriter As SpreadsheetWriter

Dim lsView As String

Dim lsFolder As String

Dim lsFilepath As String

Dim lsError As String

On Error GoTo CATCH

Print "Export started"

lsFolder = getTempFolder()

lsFilepath = lsFolder & EXPORT_FILENAME

If Len(Dir$(lsFilepath)) <> 0 Then

Kill lsFilepath

End If

Set lobjWriter = New CSVStreamWriter(lsFilepath)

EXPORT_AllToCSV lobjWriter, VIEW_DATABASE_INFO

Delete lobjWriter

EXPORT_createExportDocuments ldbCurrent, lsFilepath

Kill lsFilepath

Print MESSAGE_FINISHED_EXPORT

Exit Sub

CATCH:

Print formatError("EXPORT_StartScheduled - %s(%c) at line %l", Erl, Err, Error$)

Exit Sub

End Sub

Private Sub EXPORT_processDatabaseInfo(pobjWriter As SpreadsheetWriter, psView As String, pobjMapper As CSVMapper)

Dim lssnCurrent As New NotesSession

Dim ldbCurrent As NotesDatabase

Dim lvwExport As NotesView

Dim ldcUnprocessed As NotesDocumentCollection

Set ldbCurrent = lssnCurrent.Currentdatabase

On Error GoTo CATCH

If Len(psView) <> 0 Then

Set lvwExport = ldbCurrent.getView(psView)

If Not lvwExport Is Nothing Then

EXPORT_exportView lvwExport, pobjWriter, pobjMapper

Exit Sub

End If

Set ldcUnprocessed = ldbCurrent.UnprocessedDocuments

If ldcUnprocessed.count = 0 Then

Set ldcUnprocessed = ldbCurrent.Alldocuments

End If

EXPORT_ExportDocuments ldcUnprocessed, pobjWriter, pobjMapper

Exit Sub

CATCH:

Print formatError("ProcessDatabaseInfo: %l: %s", Erl, Err, Error$)

Exit Sub

End Sub

Private Function StringToValue(psString As String, piType As Integer) As Variant

Dim lvValue As Variant

Dim liX As Integer

On Error GoTo CATCH

If (piType And FIXED_ARRAY) <> 0 Then ' Fixed Array

lvValue = Split(psString, ";")

For liX = LBound(lvValue) To UBound(lvValue)

lvValue(liX) = StringToValue(lvValue(liX), piType Xor FIXED_ARRAY)

Else

Select Case piType:

Case 2: 'V_INTEGER

lvValue = CInt(psString)

Case 3: 'V_LONG

lvValue = CLng(psString)

Case 7: 'V_DATE

lvValue = CDat(psString)

Case 8: 'V_STRING

lvValue = psString

Case Else:

lvValue = psString

End Select

End If

GoTo FINALLY

CATCH:

Print "Error"

Resume FINALLY

FINALLY:

On Error GoTo 0

StringToValue = lvValue

End Function

Private Sub EXPORT_createExportDocuments(pdbCurrent As NotesDatabase, psFilename As String)

Dim lssnCurrent As New NotesSession

Dim lsmIn As NotesStream

Dim lsmOut As NotesStream

Dim lsHeaders As String

Dim lsLine As String

Dim llLineNumber As Long

Dim lsNumberedFilename As String

Dim liNumber As Integer

Set lsmIn = lssnCurrent.createStream()

Set lsmOut = lssnCurrent.createStream()

lsmIn.open psFilename, "UTF-16"

lsHeaders = lsmIn.readText(STMREAD_LINE, EOL_PLATFORM)

liNumber = 0

llLineNumber = 0

lsNumberedFilename = FUNCTIONS_adjustFilenumber(psFilename, liNumber)

lsmOut.open lsNumberedFilename, "UTF-16"

lsmOut.Writetext lsHeaders, EOL_NONE 'no need to wrte EOL, it's already included in line

Do Until False

lsLine = lsmIn.Readtext(STMREAD_LINE, EOL_PLATFORM)

If Len(lsLine) = 0 Then

Exit Do

End If

lsmOut.writeText lsLine, EOL_NONE

llLineNumber = llLinenumber + 1

If llLinenumber >= EXPORT_MAXLINES Then

lsmOut.Close

EXPORT_createExportDocument pdbCurrent, lsNumberedFilename

Kill lsNumberedFilename

llLineNumber = 0

liNumber = liNumber + 1

lsNumberedFilename = FUNCTIONS_adjustFilenumber(psFilename, liNumber)

lsmOut.open lsNumberedFilename, "UTF-16"

lsmOut.Writetext lsHeaders, EOL_NONE

End If

Loop

lsmOut.close

If llLinenumber > 0& Then

EXPORT_createExportDocument pdbCurrent, lsNumberedFilename

Kill lsNumberedFilename

ElseIf Len(Dir$(lsNumberedFilename)) <> 0 Then

Kill lsNumberedFilename

End If

lsmIn.close

End Sub

Private Function FUNCTIONS_adjustFilenumber(psFilenameIn As String, piNumber As Integer) As String

Dim liX As Integer

liX = InStr(psFilenameIn, ".")

FUNCTIONS_adjustFilenumber = Left$(psFilenameIn, liX - 1) & "_" & Format$(piNumber, "000") & Mid$(psFilenameIn, liX)

End Function

Private Sub EXPORT_ExportDocuments(pdcUnprocessed As NotesDocumentCollection, pobjWriter As SpreadsheetWriter, pobjMapper As CSVMapper)

Dim ldocProcess As NotesDocument

Dim lStatus As StatusBar

On Error GoTo CATCH

'Export document collection

Set lStatus = New StatusBar("Exporting to csv %s/%s", pdcUnprocessed.count)

Set ldocProcess = pdcUnprocessed.getFirstDocument()

Do Until ldocProcess Is Nothing

If ldocProcess.getItemValue("Form")(0) = "DbInfo" Then

EXPORT_processDocument ldocProcess, pobjWriter, pobjMapper

End If

Set ldocProcess = pdcUnprocessed.getNextDocument(ldocProcess)

lStatus.increment

Loop

Exit Sub

CATCH:

Print formatError("ExportDocuments - %s(%c) at line %l", Erl, Err, Error$)

Exit Sub

End Sub

Private Function getConditionDateString(psCondition As String) As String

If psCondition ="0" Then

getConditionDateString = "before"

Else

getConditionDateString = "after"

End If

End Function

Private Function calculateFormula(pdocSource As NotesDocument, pvValue As Variant)

Dim lvResult As Variant

Dim liPos As Integer

Dim lsFormula As String

lsFormula = pvValue

'replace the :: markers by a ;

liPos = InStr(lsFormula, "::")

While liPos > 0

lsFormula = Left$(lsFormula, liPos - 1) & ";" & Mid$(lsFormula, liPos + 2)

liPos = InStr(liPos, lsFormula, "::")

Wend

On Error GoTo CATCH

lvResult = Evaluate(lsFormula, pdocSource)

If IsArray(lvResult) Then

calculateFormula = CStr(lvResult(0))

Else

lvResult = ""

End If

Exit Function

CATCH:

Print formatError("calculateFormula: %s(%c) at Line %l", Erl, Err, Error$)

Exit Function

End Function

Private Function getTempFolder() As String

Dim lssnCurrent As New NotesSession

Dim lsFolder As String

Dim lvValue As Variant

Dim lsPlatform As String

lsPlatform = lssnCurrent.Platform

If Left$(lsPlatform, 7) = "Windows" Then

lsFolder = Environ$(TMP_W32)

If lsFolder = "" Then

lsFolder = "C:\Temp\"

End If

If Right$(lsFolder, 1) <> "\" Then

lsFolder = lsFolder & "\"

End If

Else 'assume POSIX compliant systen

lsFolder = Environ$(TMP_TUX)

If lsFolder = "" Then

lsFolder = "/tmp/"

End If

If Right$(lsFolder, 1) <> "/" Then

lsFolder = lsFolder & "/"

End If

lssnCurrent.SetEnvironmentVar ENVIRONMENT_EXPORT_DIALOG, lvValue, False

getTempFolder = lsFolder

End Function

Public Sub EXPORT_CallExportOnClient

Dim lwsCurrent As New NotesUIWorkspace

Dim lsFilePath As String

Dim lsFolder As String

Dim lobjWriter As SpreadsheetWriter

lsFolder = getSaveFolder()

If Len(lsFolder) = 0 Then

Exit Sub

End If

lsFolder = folderDialog(lsFolder)

If lsFolder <> "" Then

lsFilepath = lsFolder & "\" & EXPORT_NAME & EXTENTION_CSV

If Len(Dir$(lsFilepath)) <> 0 Then

Kill lsFilepath

End If

Set lobjWriter = New CSVStreamWriter(lsFilepath)

EXPORT_AllToCSV lobjWriter, ""

Print "Export to " & lsFilepath & " completed."

Else

Print "Export canceled"

End If

End Sub

Lotus Domino script snippet for Lotus Notes CSV export

You Might Also Like

Lotus Domino script to log all scheduled server agents

Find SharePoint Online sites with certain name – PNP PowerShell script

Notes Database Backup ZIP Agent