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
Lotus Notes CSV Export

Lotus Domino script snippet for Lotus Notes CSV export

or email us

Lotus Domino script snippet for Lotus Notes CSV export

You Might Also Like

Empty Library content on SharePoint Online PNP PowerShell script

Lotus Domino script snippet: Drive free space notification

Lotus Domino script snippet export any Notes view to Excel

Let’s meet!

or email us
