我寫了一個小的自定義類來在Lotus Notes 8.5.2中運行審計跟蹤。我在我的自定義類中設置了NotesRichTextItem的值,並且一切都很正常。當我退出我的自定義類時,回到Querysave,並檢查Source.Document,我可以看到值很好。 querysave完成後(我的自定義類調用後的行是End Sub),我檢查文檔屬性,並且該字段爲空。我將包括下面的所有代碼,雖然從我的querysave調用的函數是querySaveCheckValues(我通過源代碼)。問題在querysave中通過自定義類保存文檔的值
自定義類
Option Public
Option Declare
Public Class AuditTrail
REM boolean to audit all document items or use item list
Private includeAllItems As Boolean
Private currentDoc As NotesDocument
Private session As NotesSession
Private AUDIT_FIELD_LIST As String
Private AUDIT_FIELD As string
Private auditFieldList As NotesItem
Private postOpenValues List As String
Private auditField As NotesRichTextItem
Private MULTI_VALUE_SEPARATOR As String
'default message value insert strings
Private INSERT_FIELD_NAME As String
Private INSERT_OLD_VALUE As String
Private INSERT_NEW_VALUE As string
'message string defaults
Private DEFAULT_MESSAGE_CHANGE As String
'********** Sub new **********
Sub New(Source As NotesUIDocument)
dim currentDoc As NotesDocument
'put received uiDoc into NotesDocument
Set currentDoc = source.Document
REM set some class variables
setDefaultStrings
includeAllItems = True 'Details to all items on document
Set session = New NotesSession()
REM Check if the pre-defined audit field exists. If it doesn't we will audit all fields
If currentDoc.hasItem(AUDIT_FIELD_LIST) Then
'check if audit field list has at least one value
If UBound(currentDoc.GetItemValue(AUDIT_FIELD_LIST)) > 0 Then
includeAllItems = False
'assign field to NotesItem
Set auditFieldList = currentDoc.GetFirstItem(AUDIT_FIELD_LIST)
End If
End If
'get handle to audit field
If Source.Isnewdoc Then
Set auditField = New NotesRichTextItem(currentDoc, AUDIT_FIELD)
End If
Set auditField = currentDoc.GetFirstItem(AUDIT_FIELD)
End Sub
'********** collect values from current document **********
Function postOpenCollectValues(Source As NotesUIDocument)
Dim currentDoc As NotesDocument
Dim docItem As NotesItem
Dim fieldName As String
Dim fieldValue As String
Set currentDoc = Source.Document
If includeAllItems = False then
If Not auditFieldList Is Nothing Then
'list through values, find field and add to list
Dim i%
For i = 0 To UBound(auditFieldList.Values)
fieldName = auditFieldList.Values(i)
'look for item on document
If currentDoc.Hasitem(fieldName) Then
Set docItem = currentDoc.GetFirstItem(fieldName)
'check if item is multivalue
If UBound(docItem.Values) > 0 Then
fieldValue = Join(docItem.Values,MULTI_VALUE_SEPARATOR)
Else
fieldValue = docItem.Values(0)
End If
'convert value to string and put into list
postOpenValues(fieldName) = fieldValue
End If
Next
End If
End if
End Function
'********** Query save check to see if any values have changed **********
Function querySaveCheckValues(Source As NotesUIDocument)
Dim docItem As NotesItem
Dim fieldName As String
Dim oldValue, newValue As String
Set currentDoc = Source.Document
'Use list of fields generated during post open to save from etting errors when new fields
'are added to forms
ForAll x In postOpenValues
'eliminate mess if field has been removed from form
If currentDoc.hasItem(ListTag(x)) Then
Set docItem = currentDoc.GetFirstItem(ListTag(x))
fieldName = ListTag(x)
'compare old and new value
oldValue = x
If UBound(docItem.Values) > 0 Then
newValue = Join(docItem.Values,MULTI_VALUE_SEPARATOR)
Else
newValue = docItem.Values(0)
End If
Call me.compareValues(fieldName, CStr(oldValue), Newvalue)
End If
End ForAll
'make sure any changes added to audit field in backend and not overwriten
' Call Source.Refresh(true)
End Function
'********** Simple function to write lines to audit **********
Private Function writeAudit(message As String)
Dim tmpItem As NotesRichTextItem
Dim dateTime As New NotesDateTime(Now)
Dim nameItem As New NotesName(session.Username)
'take a copy of the current audit field content and blank audit
Set tmpItem = New NotesRichTextItem(currentDoc, "tmpAudit")
Call tmpItem.AppendRTItem(AuditField)
Call auditField.Remove()
'create a new audit field item and add new message
Set AuditField = New NotesRichTextItem(currentDoc, AUDIT_FIELD)
Call AuditField.AppendText(CStr(dateTime.LSLocalTime))
Call AuditField.AddTab(1)
Call AuditField.AppendText(nameItem.Abbreviated)
Call AuditField.AddTab(1)
Call AuditField.AppendText(message)
'append previous audit field content
Call AuditField.AppendRtItem(tmpItem)
Call tmpItem.remove()
End Function
'********** Function to compare single and multi values **********
Private Function compareValues(fieldName As String, oldValue As String, newValue As String)
Dim Message As String
'check for multi value
If InStr(oldValue,MULTI_VALUE_SEPARATOR) = 0 Then
'single value
If newValue <> oldValue Then
'prepare message
Message = prepareMessage(fieldName, oldValue, newValue, "CHANGE")
Call writeAudit(Message)
End If
End If
End Function
'********** Replace values in default message with old and new values **********
Private Function prepareMessage(fieldName As String, oldValue As String, newValue As String, messageType As String) As string
Dim tmpMessage As String
'case statement for type
Select Case messageType
Case "CHANGE"
tmpMessage = DEFAULT_MESSAGE_CHANGE
'replace default insert text with real field name
tmpMessage = Replace(tmpMessage,INSERT_FIELD_NAME,fieldName)
'old value
tmpMessage = Replace(tmpMessage,INSERT_OLD_VALUE,oldValue)
'new value
tmpMessage = Replace(tmpMessage,INSERT_NEW_VALUE,newValue)
End Select
prepareMessage = tmpMessage
Exit function
End Function
'********** Little function to setup our equivelant of constants **********
Private Function setDefaultStrings
AUDIT_FIELD_LIST = "auditFieldList" 'default audit field list name
AUDIT_FIELD = "AuditField" 'field used to store audit
MULTI_VALUE_SEPARATOR = "~" 'Used to combine and split values in a multi value item
'Default message insert strings
INSERT_FIELD_NAME = "%FIELDNAME%"
INSERT_OLD_VALUE = "%OLDVALUE%"
INSERT_NEW_VALUE = "%NEWVALUE%"
'Messages Strings
DEFAULT_MESSAGE_CHANGE = "Value of field '" & INSERT_FIELD_NAME & _
"' amended from '" & INSERT_OLD_VALUE & "' to '" & INSERT_NEW_VALUE & "'"
End Function
'********** handle error messages generated by this code **********
Private Function handleErrors
const DEFAULT_ERROR_MESSAGE = "Unable to write audit information - an error occured"
'if we have a handle on the audit field write an entry
If Not auditField Is Nothing Then
writeAudit(DEFAULT_ERROR_MESSAGE)
End If
End Function
End Class
爲什麼要刪除現有的審計字段並創建一個新的?追加新的審計信息會不會更容易? –