I want to share a little LotusScript code that compares the items of two documents, and which can be used e.g. to compare conflict documents.
The main function is "compareDocuments" which expects the two documents as parameters.
Adjust the constant "LOGFILEPATH" for the filepath of the log output.
The comparison goes step by step, from checking the existence in the other document, to the item types, to the item values.
Why do I use lists of a class CL_ItemCompare? Because it is slightly faster to read the items once and then access the cached information than to have to access the documents twice for the same information (as it would be the case in the second items loop in the function "compareDocuments").
'CompareDocuments: Option Public
Option DeclareClass CL_ItemCompare
Public itName As String
Public itType As String
Public itValues As Variant
Public isChecked As Boolean
Sub new(it As NotesItem)
Me.itName = it.Name
Me.itType = it.Type
Me.itValues = it.Values
Me.isChecked = False
End Sub
End Class
Function compareDocuments(doc1 As NotesDocument, doc2 As NotesDocument) As Boolean
On Error Goto errorhandler
Const LOGFILEPATH = "C:\\comparedocs.txt"
Open LOGFILEPATH For Output As #1
Print #1, "Comparing [" & doc1.UniversalID & "], [" & doc2.UniversalID & "]"
' get all items from doc1
Dim listItCompare1 List As CL_ItemCompare
Dim itx As NotesItem
If Not Isempty(doc1.Items) Then
Forall it In doc1.Items
Set itx = it
Set listItCompare1(Lcase(itx.name)) = New CL_ItemCompare(itx)
End Forall
End If
' get all items from doc2
Dim listItCompare2 List As CL_ItemCompare
If Not Isempty(doc2.Items) Then
Forall it In doc2.Items
Set itx = it
Set listItCompare2(Lcase(itx.name)) = New CL_ItemCompare(itx)
End Forall
End If
' compare all items of doc1 with items in doc2
Forall itCompare1 In listItCompare1
If Not compareItems(itCompare1, listItCompare1, listItCompare2) Then Goto e
End Forall
' all items of doc2 that have not been treated yet are missing in doc1
Forall itCompare2 In listItCompare2
If Not itCompare2.isChecked Then
Print #1, "Item '" & itCompare2.itName & "': [DOES NOT EXIST, exists]"
End If
End Forall
compareDocuments = True
e:
Close
Exit Function
errorhandler:
Msgbox "compareDocuments: Error " & Error & " in line " & Erl
Resume e
End FunctionFunction compareItems(itCompare1 As CL_ItemCompare, _
listItCompare1 List As CL_ItemCompare, _
listItCompare2 List As CL_ItemCompare) As Boolean
On Error Goto errorhandler
itCompare1.isChecked = True
' check if item of doc1 exists in doc2
If Not Iselement(listItCompare2(Lcase(itCompare1.itName))) Then
Print #1, "Item '" & itCompare1.itName & "': [exists, DOES NOT EXIST]"
compareItems = True
Exit Function
End If
' get item of doc2
Dim itCompare2 As CL_ItemCompare
Set itCompare2 = listItCompare2(Lcase(itCompare1.itName))
itCompare2.isChecked = True
' compare types
If itCompare1.itType <> itCompare2.itType Then
Print #1, "Item '" & itCompare1.itName & ": type = [" & itCompare1.itType & _
", " & itCompare2.itType & "]"
compareItems = True
Exit Function
End If
' compare typename of values
If Typename(itCompare1.itValues) <> Typename(itCompare2.itValues) Then
Print #1, "Item '" & itCompare1.itName & ": typename of values = [" & _
Typename(itCompare1.itValues) & ", " & Typename(itCompare2.itValues) & "]"
compareItems = True
Exit Function
End If
' compare item values
Dim isEqual As Boolean
Dim i As Integer
Dim txtValue1 As String
Dim txtValue2 As String
Dim isFirst As Boolean
If Instr(Typename(itCompare1.itValues), "( )") > 0 Then ' compare arrays
' compare ubound of item values array
If Ubound(itCompare1.itValues) <> Ubound(itCompare2.itValues) Then
Print #1, "Item '" & itCompare1.itName & ": ubound(values) = [" & _
Ubound(itCompare1.itValues) & ", " & Ubound(itCompare2.itValues) & "]"
compareItems = True
Exit Function
End If
' compare single array entries
isEqual = True
For i = 0 To Ubound(itCompare1.itValues)
If itCompare1.itValues(i) <> itCompare2.itValues(i) Then
isEqual = False
Exit For
End If
Next
If Not isEqual Then
' concatenate values (we cannot use join here if values are e.g. array of integers)
txtValue1 = ""
isFirst = True
Forall x In itCompare1.itValues
If Not isFirst Then
txtValue1 = txtValue1 & ";"
Else
isFirst = False
End If
txtValue1 = txtValue1 & Cstr(x)
End Forall
' concatenate values (we cannot use join here if values are e.g. array of integers)
txtValue2 = ""
isFirst = True
Forall x In itCompare2.itValues
If Not isFirst Then
txtValue2 = txtValue2 & ";"
Else
isFirst = False
End If
txtValue2 = txtValue2 & Cstr(x)
End Forall
Print #1, "Item '" & itCompare1.itName & ": values = [" & txtValue1 & ", " & txtValue2 & "]"
compareItems = True
Exit Function
End If
Else ' compare single value (i.e. NotesRichtextItem.Values)
If itCompare1.itValues <> itCompare2.itValues Then
Print #1, "Item '" & itCompare1.itName & ": values = [" & itCompare1.itValues & _
", " & itCompare2.itValues & "]"
compareItems = True
Exit Function
End If
End If
' items are equal
Print #1, "Item '" & itCompare1.itName & ": is equal"
compareItems = True
e:
Exit Function
errorhandler:
Msgbox "compareItems: Error " & Error & " in line " & Erl
Resume e
End Function
Sub Terminate
End Sub