This code allows you to store the names of field to validate and associated error message in a lookup document then cycle through the items on a document for validation errors. All the errors are then displayed to the user on a single form.
Option Public
Option Explicit
Use "Global"
Public FieldName() As String
Public ErrorMsg() As String
Public SpecialVal() As String
Public ItemVal As Integer
Public Function DocValidation(db As NotesDatabase, doc As NotesDocument, strOption As String) As Integer
%REM
Fields to be validated stored in Lookup documents.
%END REM
Dim col As NotesDocumentCollection
Dim resp As NotesDocument
Dim item As NotesItem
Dim strForm$, strItemForm$
Dim strDisplay$, strItemDisplay
Dim i%, intUB%
Dim intCounter%, intErrorCounter%
Dim msg$()
Dim varReturn
Dim strMacro$
'initialize
DocValidation = 0
intCounter = 0
'use event type to build key fo DBLookup
Set item = doc.GetFirstItem(ETYPE)
If Not (item Is Nothing) Then
strForm = item.Values(0)
End If
'build display value for error form
Set item = doc.GetFirstItem(TRACK)
If Not (item Is Nothing) Then
strDisplay = "#" & item.Text & " -- "
End If
Set item = doc.GetFirstItem(DESC)
If Not (item Is Nothing) Then
strDisplay = strDisplay & item.Text
End If
'load field names and error messages for both the header and the item check
Call LoadValues(db, strForm, strOption)
'validate event header
intUB = Ubound(FieldName)
For i = 0 To intUB
Set item = doc.GetFirstItem(FieldName(i))
If item Is Nothing Then
'if item doesn't exist, that means it wasn't filled out and should have been so
'retrieve validation message to display
intCounter = intCounter + 1
Redim Preserve msg(intCounter)
msg(intCounter-1) = ErrorMsg(i)
Else 'if the item is there, see it it's got a value
If Len(Trim(item.Text)) = 0 Then
intCounter = intCounter + 1
Redim Preserve msg(intCounter)
msg(intCounter-1) = ErrorMsg(i)
End If
End If
Next 'fieldname
'create error message box
If intCounter > 0 Then
Call DisplayError(db, msg, strDisplay)
Exit Function
Else
DocValidation = True
End If
End Function
Private Sub LoadValues(db As NotesDatabase, strForm$, strOption$)
%REM
NOTE: Can't use DBLookup function because collecting AllDocumentsByKey not just one
%END REM
Dim valcol As NotesDocumentCollection
Dim view As NotesView
Dim valdoc As NotesDocument
Dim item As NotesItem
Dim strKey$
Dim intCount%, i%, intUB%
'initialize item validation flag
ItemVal = True
'construct keys
strKey = "_VALIDATION*"&strForm & strOption
'collect validation documents
Set view = db.GetView(cLOOKUP2)
Set valcol = view.GetAllDocumentsByKey(strKey)
intCount = valcol.Count
If intCount > 0 Then
i = 0
intUB = intCount -1
Redim FieldName(intUB)
Redim ErrorMsg(intUB)
Set valdoc = valcol.GetFirstDocument
While Not (valdoc Is Nothing)
FieldName(i) = valdoc.GetItemValue("Field_1")(0)
ErrorMsg(i) = valdoc.GetItemValue("Field_2")(0)
Set valdoc = valcol.GetNextDocument(valdoc)
i = i +1
Wend
Else
'set flag to not perform item validation
ItemVal = False
End If
End Sub
Private Function DisplayError(db As NotesDatabase, msg, strDisplay, eventdoc As NotesDocument) As Integer
Dim uiw As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim errorDoc As NotesDocument
Dim Item As NotesItem
Dim flag
Set errorDoc = db.CreateDocument
' errorDoc.Form = "Error"
Call errorDoc.ReplaceItemValue("Display", strDisplay)
Set item = New NotesItem(errorDoc,"DocErrors", msg)
flag = uiw.DialogBox("Error", True, True, False, True, True, True, "Validation error...", errorDoc)
If flag Then
Set uidoc = uiw.EditDocument(True, eventdoc)
DisplayError =2
Else
DisplayError =1
End If
End Function
This was first published in August 2001