Option Public Option Explicit Dim TrackingCurrent List As Variant Sub TrackingInit(doc As notesdocument) 'Called by PostOpen 'To get current values of fields to be tracked (if any) If doc.TrackingFields(0)="" Then Exit Sub 'no fields to track Forall f In doc.trackingfields TrackingCurrent(f)=Assemble(doc,f) End Forall End Sub Sub TrackingVerify (doc As Notesdocument) 'Called by QuerySave 'Compares stored values of Tracking fields with current values 'Keeps track of changes to those values If doc.TrackingFields(0)="" Then Exit Sub 'no fields to track Dim session As New NotesSession Dim changes As String Dim change1 As String Dim currentval As String changes="" Forall f In doc.trackingfields currentval=Assemble(doc,f) If TrackingCurrent(f)<>currentval Then 'there is a changes, so track it change1=f & ": '" & TrackingCurrent(f) & "' >>> '" & currentval & "'" If changes="" Then changes=change1 Else changes=changes & Chr(13) & change1 End If End Forall If changes<>"" Then doc.ChangedDD=Now doc.ChangedBy=session.UserName doc.Changed=Split(changes,Chr(13)) 'Reset the values, so consecutive saves won't necessarily create a new document Erase TrackingCurrent TrackingInit doc End If End Sub Function Assemble (fDoc As Notesdocument, fName As String) As String Dim item As NotesItem If fdoc.hasitem(fName) Then Set item = fdoc.GetFirstItem(fName) Assemble=Join(Fulltrim(item.Values),"|") Assemble=Replace(Assemble,Chr(13), "," ) Assemble=Replace(Assemble,Chr(10), "") Else Assemble="" End If End Function Sub TrackingVerifyDB (doc As NotesDocument) 'Called by QuerySave 'Compares stored values of Tracking fields with current values 'Keeps track of changes to those values 'Stores the changes in a separate database (using field 'TrackingDB') 'And field 'TrackingInfo' containing the list of fields to store too If doc.TrackingFields(0)="" Then Exit Sub 'no fields to track Dim session As New Notessession Dim tdb As notesdatabase Dim tdoc As notesdocument Dim changes As String Dim change1 As String Dim infos As String Dim info1 As String Dim currentval As String changes="" Forall f In doc.trackingfields currentval=Assemble(doc,f) If TrackingCurrent(f)<>currentval Then 'there is a changes, so track it change1=f & ": '" & TrackingCurrent(f) & "' >>> '" & currentval & "'" If changes="" Then changes=change1 Else changes=changes & Chr(13) & change1 End If End Forall If changes<>"" Then doc.ChangedDD=Now doc.ChangedBy=session.commonusername doc.Changed=Split(changes,Chr(13)) If doc.TrackingDB(0)<>"" Then 'also store in Tracking DB Set tdb = New notesdatabase("","") Call tdb.open(session.currentdatabase.server,doc.TrackingDB(0)) If tdb.isopen Then 'see if target db is available Set tdoc=tdb.createdocument With tdoc .Form="Change" .ChangedDD=Now .ChangedBy=session.commonusername .Changed=changes infos="" Forall f In doc.trackinginfo 'loop over all Info fields currentval=Assemble(doc,f) info1=f & ": " & currentval If infos="" Then infos=info1 Else infos=infos & Chr(13) & info1 End Forall .Info=infos .CreatedBy=doc.creator .CreatedDD= doc.Created .SourceUNID=doc.universalid .SourceServer=session.currentdatabase.server .SourceDB=session.currentdatabase.filepath .SourceForm=doc.Form Call .save(False,False) End With End If End If 'Reset the values, so consecutive saves won't necessarily create a new document Erase TrackingCurrent TrackingInit doc End If End Sub