在 querysave 中通过自定义类将值保存到文档时出现问题

Question

我编写了一个小型自定义类来在 Lotus Notes 8.5.2 中运行审计跟踪。我在自定义类中设置了 NotesRichTextItem 的值，一切看起来都很好。当我退出自定义类，返回到 Querysave 并检查 Source.Document 时，我可以看到该值很好。一旦查询保存完成（我的自定义类调用之后的行是 End Sub），我检查文档属性并且该字段为空。我将包含下面的所有代码，尽管从 querysave 调用的函数是 querySaveCheckValues（我传入 Source）。

定制类

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 

Answer 1

我认为如果将对类的调用移至 PostSave 事件而不是 QuerySave，您的代码将会起作用。

我的基础是，您正在 QuerySave 事件中更改后端文档，并且在该事件运行之后，它应该使用前端的新值覆盖后端文档。不过，这只是一种预感，因为我还没有证实情况确实如此。