I have a subform that displays any field modifications made on the form. Below are the objects: Postopen, Querysave, SetFieldContents, GetFieldValue and StringSub script.
My question is, right now this displays any field modificaitons, but what I would like to add to it is to also display the field if it is blank which I think I need to change the script in the GetFieldValue but not sure how.
Postopen:
Sub Postopen(Source As Notesuidocument)
Set session = New NotesSession
old(“FieldName”) = Source.FieldGetText(“FieldName”)
old(“AnotherFieldName”) = Source.FieldGetText(“AnotherFieldName”)
End Sub
Querysave:
Sub Querysave(Source As Notesuidocument, Continue As Variant)
On Error Goto E
Source.Refresh
On Error Goto 0
initial = Source.IsNewDoc
If initial Then m$ = session.CommonUserName & " - " & Cstr(Now()) & " - created document"
Forall F In old
v$ = Source.FieldGetText(Listtag(F))
If Not initial And Not v$ = F Then
If m$ = "" Then
m$ = session.CommonUserName & " - " & Cstr(Now()) & " - modified "
Else
m$ = m$ & ", "
End If
If F = "" Then F = {xxxxx}
‘’’
Select Case Listtag(F)
Case “FieldName” : T$ = “Field Name”
Case “AnotherFieldName” : T$ = “Another Field Name”
End Select
‘’’
If F <> "xxxxx" Then 'added 3/25/13
m$ = m$ & T$ & " from " & F & " to " & v$
End If
End If
F = v$
End Forall
If initial Then
Source.FieldSetText "FieldContents", m$
Elseif Not m$ = "" Then
Source.FieldAppendText "FieldContents", Chr$(10) & m$
End If
X: Exit Sub
E: Continue = False
Resume X
End Sub
SetFieldContents:
Sub SetFieldContents (Source As NotesUIDocument)
'This routine will look for a list of field names in the multi-value field “MonitorFields”. For each field in the list
'this routine will extract the existing values from the field and store then as a concatenated string in the
’ If in edit mode then save the existing status value (before user changes it).
Dim docCurrent As NotesDocument
Dim itemFieldContents As NotesItem, itemField As NotesItem
Dim vFieldList As Variant
Set docCurrent = Source.Document
If Source.EditMode Then
vFieldList = docCurrent.MonitorFields ' Get list of fields to monitor
Set itemFieldContents = docCurrent.ReplaceItemValue("FieldContents","") ' Clear the list of field values
Forall Field In vFieldList ' for each field in the list of fields to monitor
Set itemField=docCurrent.GetFirstItem(Field) ' get handle to that field
Call itemFieldContents.AppendToTextList(GetFieldValue(itemField)) ' then write the value out to the Field containing all the values.
End Forall
End If
End Sub
GetFieldValue:
Function GetFieldValue(itemField As NotesItem) As String
'This routine will take a specified notesitem and return its contents as a string. If the field is multivalue then
'a string with the items seperated as colons will be produced. Strings are returned in speach marks and
'dates are returned in square brackets.
Dim sFieldValue As String
If itemField Is Nothing Then ' if the field does not already exist then assume its value is blank
sFieldValue="*"
Else
sFieldValue = ""
If itemField.Type <> RICHTEXT Then ' return a blank string for RTF field.
Forall Values In itemField.Values ' otherwise take each value in the field
If Datatype(Values) = V_STRING Then Values = |"| & Values & |"| ' if a string wrap it in speach marks.
If Datatype(Values) = V_DATE Then Values = |[| & Values & |]| ' if a string wrap it in speach marks.
’ then concatenate all values together into a string replacing semicolons with colons, and CRLF with ~#
sFieldValue = sFieldValue & StringSub(StringSub(Cstr(Values),";",","),Chr(13)+Chr(10),"~#") & ":"
End Forall
If sFieldValue<>"" Then sFieldValue = Left(sFieldValue, Len(sFieldValue)-1) ' strip off the last colon if there is one.
End If
End If
GetFieldValue = sFieldValue
End Function
StringSub:
Function StringSub(sFullString As String, sSearchString As String, sReplacementString As String) As String
'Routine will search the given string (sFullString) and replace any instance
'of sSearchString with sReplacementString. This routine is most useful
'for the replacment of a particular character in a string with another.
Dim iStringPos As Integer
iStringPos=Instr(sFullString,sSearchString)
If iStringPos=0 Then
StringSub=sFullString
Exit Function
End If
If iStringPos<>0 Then
StringSub=Left(sFullString,iStringPos-1) + sReplacementString + StringSub(Mid(sFullString,iStringPos+Len(sSearchString)),sSearchString, sReplacementString)
End If
End Function
Thanks!!