'Record Doc Changes: Option Public Option Explicit Option Compare Nocase Use "AgentBoost" %REM PLEASE NOTE: If you are using the latest version of the database (which is now called TriggerHappy), you should use the sample agent provided with it instead of this one. It is the same agent, with a few changes to reflect the new names of the TriggerHappy script library and class. %END REM Class Logger '** A simple class for logging data to something. In this example, '** we'll just be printing information to the console, but you'd '** normally want to write to a database or something Public Sub New () '** nothing to do in this case End Sub Public Sub write (txt As String) Print txt End Sub Public Sub save () '** nothing to save here End Sub End Class Sub Initialize '** This is an example of using AgentBoost to track changes to documents. '** Just create a Booster event that occurs before a document is modified '** or saved, attached to whatever database(s) you're concerned with, and '** point the event to this agent. (NOTE: at this time the oldDoc and '** newDoc references will be the same, so you won't log any changed fields; '** I'm trying to find a workaround) On Error Goto processError Dim session As New NotesSession Dim bs As New BoostSession Dim db As NotesDatabase Dim oldDoc As NotesDocument Dim newDoc As NotesDocument Set newDoc = session.DocumentContext If bs.IsPreEvent Then '** we got the document before it was saved, so we might be able to '** grab the existing version of the doc to see what changed If (Len(bs.UniversalID) > 0) Then '** try to get the existing doc using the UNID of the new one Set db = newDoc.ParentDatabase Set oldDoc = db.GetDocumentByUNID(bs.UniversalID) End If Call LogDocChanges(oldDoc, newDoc, bs.UserName) Else '** this is a PostEvent, so the doc has already been saved, so just report '** on the new doc. It would be possible to try to lookup the old version '** of the doc in a replica database somewhere, if you're really concerned '** about what was in the old doc -- this could impact performance and '** require some hard-coding of things, though Call LogDocChanges(Nothing, newDoc, bs.UserName) End If Exit Sub processError: '** use your favorite error logging routine here Print "Error " & Err & " on line " & Erl & " of Record Doc Changes agent: " & Error Exit Sub End Sub Function LogDocChanges (oldDoc As NotesDocument, newDoc As NotesDocument, userName As String) As Integer '** log the changes that were made between the old doc and the new doc On Error Goto processError '** if this function was called without a valid newDoc reference, just exit If (newDoc Is Nothing) Then Exit Function End If '** start writing to our log (please modify the Logger class as desired) Dim out As New Logger Dim sep As String sep = "============================" out.write(sep) out.write("AgentBoost has detected a change") out.write("A document has been modified or created in " & newDoc.ParentDatabase.FilePath) out.write("The new doc has a UNID of " & newDoc.UniversalID) out.write("The user who modified the doc is " & userName) out.write(sep) '** if there was no oldDoc to compare against, we can leave now If (oldDoc Is Nothing) Then out.write("Old doc not found") Goto cleanup End If '** get the field values from the old doc, so we can compare them to the new one Dim oldFields List As NotesItem Dim items As Variant Dim oldItem As NotesItem items = oldDoc.Items Forall item In items Set oldFields(item.Name) = item End Forall '** now compare the new items to the old ones, and report any discrepencies items = newDoc.Items Forall item In items If Not Iselement(oldFields(item.Name)) Then out.write("New field: " & item.Name) out.write("Field type: " & GetType(item.Type)) out.write("Text value: " & item.Text) out.write(sep) Else Set oldItem = oldFields(item.Name) If (item.Type <> oldItem.Type) Then out.write("Field '" & item.Name & "' changed type from " & _ GetType(oldItem.Type) & " to " & GetType(item.Type)) out.write(sep) End If If (item.Text <> oldItem.Text) Then out.write("Field '" & item.Name & "' changed value from:") out.write("OLD: " & oldItem.Text) out.write("to:") out.write("NEW: " & item.Text) out.write(sep) End If Erase oldFields(item.Name) End If End Forall '** the oldFields list should be empty at this point. If it's not, that means that '** there are fields in the old doc that no longer exist in the new doc, and we '** should report on those Forall item2 In oldFields out.write("Deleted field: " & item2.Name) out.write("Field type: " & GetType(item2.Type)) out.write("Text value: " & item2.Text) out.write(sep) End Forall cleanup: '** all done... save and exit out.save LogDocChanges = True Exit Function processError: '** use your favorite error logging routine here If Not (out Is Nothing) Then out.write("Error " & Err & " on line " & Erl & " of LogDocChanges: " & Error) out.save End If Exit Function End Function Function GetType (itemType As Long) As String Select Case itemType Case 1: GetType = "RICHTEXT" Case 2: GetType = "COLLATION" Case 4: GetType = "NOTEREFS" Case 6: GetType = "ICON" Case 7: GetType = "NOTELINKS" Case 8: GetType = "SIGNATURE" Case 14: GetType = "USERDATA" Case 15: GetType = "QUERYCD" Case 16: GetType = "ACTIONCD" Case 17: GetType = "ASSISTANTINFO" Case 18: GetType = "VIEWMAPDATA" Case 19: GetType = "VIEWMAPLAYOUT" Case 20: GetType = "LSOBJECT" Case 21: GetType = "HTML" Case 25: GetType = "MIME_PART" Case 256: GetType = "ERRORITEM" Case 512: GetType = "UNAVAILABLE" Case 768: GetType = "NUMBERS" Case 1024: GetType = "DATETIMES" Case 1074: GetType = "NAMES" Case 1075: GetType = "READERS" Case 1076: GetType = "AUTHORS" Case 1084: GetType = "ATTACHMENT" Case 1085: GetType = "OTHEROBJECT" Case 1090: GetType = "EMBEDDEDOBJECT" Case 1280: GetType = "TEXT" Case 1536: GetType = "FORMULA" Case 1792: GetType = "USERID" Case Else: GetType = "UNKNOWN (" & itemType & ")" End Select End Function