クエリにカスタムクラスを使用してドキュメントに値を保存する際の問題

Question

Lotus Notes 8.5.2で監査証跡を実行するための小さなカスタムクラスを作成しました。 NotesRichTextItemの値を自分のカスタムクラスに設定すると、すべてがうまく見えます。カスタムクラスを抜けてQuerysaveに戻り、Source.Documentをチェックすると、値が正しく表示されます。 querysaveが終了すると（私のカスタムクラス呼び出しの後の行はEnd Subです）、私はドキュメントのプロパティをチェックし、フィールドは空です。私はquerysaveから呼び出された関数がquerySaveCheckValues（私はSourceで渡す）ですが、以下のすべてのコードを含めます。私はあなたの代わりにQuerySaveのPostSaveイベントにあなたのクラスに呼び出しを移動した場合、あなたのコードが動作すると思い

カスタムクラス

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

。

私は、QuerySaveイベント内でバックエンド文書を変更していて、そのイベントの実行後に、バックエンド文書をフロントエンドからの新しい値で上書きする必要があるということに基づいています。しかし、私はこれを確認していないので、まあまあです。