Manage Learn to apply best practices and optimize your operations.

Synchronize Notes and Excel data

This script below logs the data changes and also changes the background color of that row to make it easy to identify.

We have a financial application, which needed to synchronize data between notes and excel in the background. What we have payment instruction data in excel and in notes, whenever a user changes the data in notes, we needed to change the respective data in excel and log the date and time it was modified. This script below logs the data changes and also changes the background color of that row to make it easy to identify.

To achieve this, I created a column in Excel which contains an unique key for each row, this key was created using different fields values from the notes document, whenever there is a change in the Notes document, this script searches through the unique key column and updates the line from notes in excel. The code below will only direct in right direction and will need adjustment. Please let me know if you need more help on this. webmaster@kamat.co.uk
Function PaymentExcelUpdate()

	
	'Error Handler
	On Error Goto Err_Handle
	
	'Define objects and variables
	Dim uidoc As notesuidocument
	Dim db As NotesDatabase
	Dim view As NotesView
	Dim tmpCount As Integer
	Dim nmore, nc, nchar 
	Dim session As NotesSession
	Dim workspace As NotesUIWorkspace
	Dim doc As notesdocument
	Dim UniqueKey As String
	Dim pdoc As notesdocument
	Dim pitm As notesitem
	Dim UPDATEFLAG As Variant
	Dim KEYFOUND As Variant
	Dim NotFoundKeys As String
	Dim FoundKeys As String
	
	'Instantiate objects and variable
	Set session = New notessession
	Set db = session.CurrentDatabase
	Set workspace = New notesuiworkspace
	Set uidoc = workspace.currentdocument
	Set doc = uidoc.document
	Set view = db.GetView( "PaymentExportViewViaBrokerDoc" )
	If view Is Nothing Then Error(4000)
	Set pdoc = db.getprofiledocument("PaymentExcelKeywords")
	If pdoc Is Nothing Then Error(4001)
	
	'GEt the path where the excel file will be saved
	Set pitm = pdoc.getfirstitem("PaymentExcelFilePath")
	If Not pitm Is Nothing Then 
		If Trim$(pitm.values(0))="" Then Error(4002)
		Dim DirectoryToSave As String
		DirectoryToSave = Trim$(pitm.values(0))
	Else
		Error(4002)
	End If
	
	'Get the name of the cell where the unique keys will be stored
	Set pitm = pdoc.getfirstitem("PaymentExcelKeyCell")
	If Not pitm Is Nothing Then 
		If Trim$(pitm.values(0))="" Then Error(4003)
		Dim UniqueKeyCellName As String
		UniqueKeyCellName = Trim$(pitm.values(0))
	Else
		Error(4003)
	End If
	
	'Get then name of the cell where th name and date of person 
	'Modifying the record will be saved
	Set pitm = pdoc.getfirstitem("PaymentExcelUpdateLog")
	If Not pitm Is Nothing Then 
		If Trim$(pitm.values(0))="" Then Error(4004)
		Dim UpdateLogCellName As String
		UpdateLogCellName = Trim$(pitm.values(0))
	Else
		Error(4004)
	End If
	
	'Get the name of fields that will be updated in excel spreadsheet from the doc
	Set pitm = pdoc.getfirstitem("PayMentExcelExportFields")
	If pitm Is Nothing Then Error(4005)
	If Trim$(pitm.values(0))="" Then Error(4005)
	
	'Find out the no of documents in the view
	Dim vc As NotesViewEntryCollection
	Set vc = view.AllEntries
	
	'Check if the payment excel file is in the directory
	If Dir$(DirectoryToSave)="" Then 
		If Msgbox ("Could not locate file  " & Trim$(DirectoryToSave) & "  in the specified directory." & Chr(10) &_
		"Please click OK to create a new file into " & Trim$(DirectoryToSave) ,36,"Create New File") = 6 Then
			Call PaymentExportToExcelViaBrokerDoc()
		Else
			Error(4007)
		End If
	End If
	
     'Launch Excel and open it in the UI
	Set excelAppObject = CreateObject("Excel.Application")
	excelAppObject.Workbooks.Open DirectoryToSave
	Set excelWorksheetObject = excelAppObject.Workbooks(1).Worksheets(1)
	
	'Lets try finding the cell for a value for document 
	UPDATEFLAG = False
	If Not doc Is Nothing Then
		
		If doc.hasitem("NoOfLines") Then
			Set itm = doc.getfirstitem("NoOfLines")
			If Trim$(itm.values(0))="" Then Error(4006)
			
			For x= 1 To Cint(doc.NoOfLines(0))
				
				'Build up the first part of the unique key 
				If doc.hasitem("Product") Then UniqueKey = doc.Product(0)
				If doc.hasitem("BrokerName") Then UniqueKey = UniqueKey & doc.BrokerName(0)
				KEYFOUND=False
				Print "Please wait ... "
				
				'Build the remaining part of the unique key
				If doc.hasitem("PaymentCurrency_" & x) Then 
					Set itm = doc.getfirstitem("PaymentCurrency_" & x)
					UniqueKey = UniqueKey & itm.values(0)
				End If
				
				'Now find the line in the excel spreadsheet
				'We need to go through all the rows in the key column
				'till we find the key then get the line number and replace all the values
				'on that line
				For i=2 To vc.count
					temp = excelWorksheetObject.Cells(i,UniqueKeyCellName).Value
					If Trim$(temp) = Trim$(Uniquekey) Then
						
						'Once the line is found, set the flag to true so that 
						'we can save the file with the changes made to it
						UPDATEFLAG =True
						KEYFOUND=True
						
						'Clear the previous updated lines color
						excelWorksheetObject.Range("A2:" + "L" + Cstr(vc.count)).Select
						With excelAppObject.Selection
							.Interior.ColorIndex = -4142 
						End With
						
						'Change the color behind the line updated						
						excelWorksheetObject.Range("A" + Cstr(i) + ":" + "L" + Cstr(i)).Select
						With excelAppObject.Selection
							.Interior.ColorIndex = 35							
						End With
						
						'Initialise the constnats 
						m_let = nchar
						nl =i
						nc=64
						nmore=0
						ocount = 0
						
						'Update the line in the excel spreadsheet
						Forall valu In pitm.values
							nc=nc+1
							If nc=91 Then
								nmore = nmore+1
								nc=65
							End If
							If nmore > 0 Then
								nchar=Cstr(Chr(nmore+64))+Cstr(Chr(nc))
							Else
								nchar = Cstr(Chr(nc))
							End If
							
							Select Case Valu
							Case "PaymentCurrency","PaymentInstructionsLong","PaymentInstructionsShort",
"PaymentInstructionSwift","AccountNumber" If doc.hasitem(valu & "_" & x) Then Set itm = doc.getfirstitem(valu & "_" & x) With excelWorksheetObject.Range(nchar + Cstr(nl)) .NumberFormat = "@" .Value = itm.values(0) End With End If Case "UniqueKey" With excelWorksheetObject.Range(UniqueKeyCellName + Cstr(nl)) .NumberFormat = "@" .Value = UniqueKey End With Case Else If doc.hasitem(valu) Then Set itm = doc.getfirstitem(valu) With excelWorksheetObject.Range(nchar + Cstr(nl)) .NumberFormat = "@" .Value = itm.values(0) End With End If End Select End Forall 'Also put the name of the person updated it With excelWorksheetObject.Range(UpdateLogCellName + Cstr(nl)) .NumberFormat = "@" .Value = Session.CommonUserName & " [ " & Now & " ] " End With End If Next Print If Not KEYFOUND Then NotFoundKeys = NotFoundKeys & Chr(10) & Trim$(Uniquekey) Else FoundKeys = FoundKeys & Chr(10) & Trim$(Uniquekey) End If Next Else Error(4006) End If End If SaveExcelFile: 'Save the file only of it has been updated If UPDATEFLAG Then 'excelAppObject.Visible = False excelAppObject.Workbooks(1).Save excelAppObject.Workbooks(1).Close 'True, "c:tempPaymentInstruction.xls" Print "Please wait ... complete" 'Displays the dialog box at the end of tasks Dim newdoc As New notesdocument(db) newdoc.General = "Update to Payment Excel file completed!" If Trim$(NotFoundKeys)="" Then NotFoundKeys="None" newdoc.Other = "Line Modified : " & FoundKeys & Chr(10) & Chr(10) & "Lines Not Modified : " & NotFoundKeys 'flag = notesUIWorkspace.DialogBox( form$ [, autoHorzFit
[, autoVertFit [, noCancel [, noNewFields [, noFieldUpdate
[, readOnly [, title$ [, notesDocument [, sizeToTable
[, noOkCancel ]]]]]]]]]] ) Call workspace.dialogbox("ExcelRoutineCompletionLog",True,True,True,False,False,False,"",newdoc ) 'excelAppObject.Visible = True End If TheEnd: Exit Function Err_Handle: 'Calls error handler routine bcos there was a script error during execution 'It will create a new error activity document with error msg, errno and user name Call ErrorHandlerRoutine( doc, Err, "PaymentExcelUpdate", phaseno ) If Isempty( excelAppObject ) = False Then excelAppObject.Workbooks(1).Close False ' If Not excelAppObject Is Nothing Then excelAppObject.Workbooks(1).Close False Resume TheEnd End Function

Dig Deeper on Domino Resources - Part 4

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchWindowsServer

Search400

  • iSeries tutorials

    Search400.com's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...

SearchDataCenter

SearchContentManagement

Close