This flexible and reusable agent template uses functions that allow you to select (3 different ways) and change (2 different ways) documents in one or more databases. It also includes built-in logging using the NotesLog class.
This is great as an implementation agent template used to change a field name or change a flag field.
(Declaration)
Dim nl As NotesLog
Dim iProcessed As Integer
Dim iError As Integer
' Global Error Constants
Const ERR_BASE_NUMBER = 10000
Const ERRN_INVALID_FUNCTION_PARAMS
= ERR_BASE_NUMBER + 10 Const
ERRS_INVALID_FUNCTION_PARAMS =
"Invalid function parameters passed to: "
Const ERRN_INVALID_OR_NON_
EXISTENT_VIEW = ERR_BASE_NUMBER
+ 11 Const
ERRS_INVALID_OR_NON_EXISTENT_VIEW =
"The view does not exist or could not be
opened: "
Const ERRN_INVALID_FT_SEARCH =
ERR_BASE_NUMBER + 12 Const
ERRS_INVALID_FT_SEARCH =
"The full-text search contains errors
and could not
be understood: "
Const ERRN_INVALID_FORMULA =
ERR_BASE_NUMBER +
13 Const ERRS_INVALID_FORMULA
= "The formula contains errors: "
' ==============================
===============================
' Type of search we want to do... for function
GetAllMatchingDocuments() ' 0 =
Use a view, 1= Use a full text search, 2=
Use a view-like selection formula.
' ================================
=============================
Const TYPE_VIEW = 0
Const TYPE_FT_SEARCH = 1
Const TYPE_SEL_FORMULA = 2
' =================================
============================
' For Notes Formula validation
' ================================
=============================
Const NULLHANDLE = 0
Const NO_ERROR = 0
Const ERR_FORMULA_COMPILATION =
&h500 + 1
Declare Function NSFFormulaCompile
Lib "nnotes.dll" ( _ Byval FormulaName As
Long, _ Byval FormulaNameLength
As Integer, _ Byval FormulaText As Lmbcs
String, _ Byval FormulaTextLength
As Integer, _ rethFormula As Long, _
retFormulaLength As Integer, _
retCompileError As Integer, _
retCompileErrorLine As Integer, _
retCompileErrorColumn As Integer, _
retCompileErrorOffset As Integer, _
retCompileErrorLength As Integer _
) As Integer
Declare Sub OSMemFree Lib "nnotes.dll"
(Byval hHandle As Long)
Declare Function OSLoadString Lib
"nnotes.dll" ( _ Byval hmodule As Long, _
Byval status As Integer, _ Byval s
As String, _ Byval slen As Integer _
) As Integer
' =================================
============================
Sub Initialize
Dim ns As New NotesSession
Dim db As NotesDatabase
Dim dbAdmin As NotesDatabase
Dim vCol As Variant
Set db = ns.CurrentDatabase
' This is the database where you want
the NotesLog entries to go... adjust
accordingly!
Set dbAdmin = ns.GetDatabase
(db.Server, "<Change this to the database
path>")
If Not db Is Nothing And db.IsOpen
And Not dbAdmin Is Nothing And
dbAdmin.IsOpen Then
' Start logging...
Set nl = New NotesLog
(ns.CurrentAgent.Name & ""
& dbAdmin.Title)
Call nl.OpenNotesLog
( dbAdmin.Server, dbAdmin.FilePath )
' ==========================
===================================
' Get hold of selected documents...
you can use a view name/alias or a
' Full-Text Search Query or a
selection formula. See the
GetAllMatchingDocuments
' function for more details.
' For example:
' Set vCol = GetAllMatchingDocuments
(db, "GlobalKeywords" , TYPE_VIEW)
' Set vCol = GetAllMatchingDocuments
(db, "Status CONTAINS Approved" ,
TYPE_FT_SEARCH)
' Set vCol = GetAllMatchingDocuments
(db, {FORM = "ErrorForm" & !
@IsAvailable(MyField)} ,
TYPE_SEL_FORMULA)
' ==============================
===============================
Set vCol = GetAllMatchingDocuments
(db, "@All" , TYPE_SEL_FORMULA)
' ==============================
===============================
' You can change documents using
LoopOverAllDocuments() and ProcessDocument
()
' in a loop-like operation...
(for complex / multi-fields operations)
' OR
' Change one field in all documents to
a selected value (faster) using
StampAllDocuments().
'
' For example:
' Call LoopOverAllDocuments(vCol) <---
Calls ProcessDocument() where you
can add your logic.
' Documents should be saved in the
ProcessDocument() function.
' Call StampAllDocuments("Status",
"Archived") <--- Sets the field Status
to "Archived" in all Documents and
' creates the field if it does not exist.
Document changed with this
function don't need to be saved.
' ================================
=============================
'Call LoopOverAllDocuments(vCol)
'Call StampAllDocuments("Status",
"Archived")
Call nl.LogAction("Results for Database:
" & db.Title)
Call nl.LogAction("Number of documents
processed: " & Cstr(iProcessed) )
Call nl.LogAction("Number of errors: "
& Cstr(iError) )
End If
Call nl.Close()
End Sub
' ==============================
===================================
' This Function retrieves documents in a
database by using a view (all
entries) ' a FT Search query or a view like
selection formula.
'
' For example:
' Set vCol = GetAllMatchingDocuments(db,
"AllDocumentsView" , TYPE_VIEW)
' Set vCol = GetAllMatchingDocuments(db,
"Status CONTAINS Approved" ,
TYPE_FT_SEARCH)
' Set vCol = GetAllMatchingDocuments(db,
"FORM = ""ThisForm"" & !
@IsAvailable(ThatField)" , TYPE_SEL_FORMULA)
'
' vCol will then contain either a NotesView
(TYPE_VIEW) or a
NotesDocumentCollection
' (TYPE_FT_SEARCH or TYPE_SEL_FORMULA)
and you can use GetFirstDocument(),
etc...
' on it to access documents (since NotesView
and NotesDocumentCollection both
have those functions
' in common)
'
' If a view selection formula is used, it will be
checked by this function to
make sure
' it is valid (syntax).
' ===================================
==============================
Function GetAllMatchingDocuments
(db As NotesDatabase, sSearch As String, iType
As Integer) As Variant
Dim view As NotesView
Dim iRC As Variant
On Error Goto ErrHandler
If (db Is Nothing) Or (Not db.IsOpen) Or
(Trim$(sSearch) = "") Or (iType <
TYPE_VIEW Or iType > TYPE_SEL_FORMULA)
Then
Error ERRN_INVALID_FUNCTION_PARAMS,
ERRS_INVALID_FUNCTION_PARAMS
& "GetAllMatchingDocuments()"
End If
Select Case iType
Case TYPE_VIEW
Set view = db.GetView(sSearch)
If Not view Is Nothing Then
Set GetAllMatchingDocuments = view
Else
Error ERRN_INVALID_OR_NON_EXISTENT_
VIEW, ERRS_INVALID_OR_NON_EXISTENT_VIEW
& sSearch
End If
Case TYPE_FT_SEARCH
Set GetAllMatchingDocuments =
db.FTSearch(sSearch, 0)
If GetAllMatchingDocuments Is Nothing Then
Error ERRN_INVALID_FT_SEARCH,
ERRS_INVALID_FT_SEARCH & sSearch
End If
Case TYPE_SEL_FORMULA
iRC = CheckSelectionFormulaValid(sSearch)
If iRC(0) = NO_ERROR Then
Set GetAllMatchingDocuments = db.Search
(sSearch, Nothing, 0)
Else
Error ERRN_INVALID_FORMULA, ERRS_
INVALID_FORMULA & sSearch & "(" &
GetAPIError(iRC(0)) & ")"
Set GetAllMatchingDocuments = Nothing
End If
Case Else
' Should never be reached....
Error ERRN_INVALID_FUNCTION_PARAMS,
ERRS_INVALID_FUNCTION_PARAMS
& "GetAllMatchingDocuments()"
End Select
Exit Function
ErrHandler:
Print "Error " & Cstr(Err()) & " - " & Error$() & "
at line: " & Cstr(Erl())
Set GetAllMatchingDocuments = Nothing
Exit Function
End Function
Function StampAllDocuments(vCol As Variant,
sFieldName As String, vValue As
Variant) As Integer
Dim vc As NotesViewEntryCollection
On Error Goto ErrHandler
If (vCol Is Nothing) Or (Trim$(sFieldName) = "")
Then
Error ERRN_INVALID_FUNCTION_PARAMS,
ERRS_INVALID_FUNCTION_PARAMS
& "StampAllDocuments()"
End If
If Typename(vCol) = "NOTESVIEW" Then
Set vc = vCol.AllEntries
Call vc.StampAll(sFieldName, vValue)
StampAllDocuments = vc.Count
Else
Call vCol.StampAll(sFieldName, vValue)
StampAllDocuments = vCol.Count
End If
Exit Function
ErrHandler:
Print "Error " & Cstr(Err()) & " - " & Error$() & "
at line: " & Cstr(Erl())
& " in function StampAllDocuments()"
Exit Function
End Function
Function ProcessDocument(doc As
NotesDocument) As Integer
' ===================================
==========================
' Insert your code to modify documents
here...
' All documents found are passed to
this function.
' ===============================
==============================
' You should return true if your logic works
(document updated properly) and
' false in case of an error. (Counters
rely on the return value of this
function).
ProcessDocument = doc.Save(True,
False,False)
End Function
Sub LoopOverAllDocuments(vCol As Variant)
Dim doc As NotesDocument
Set doc = vCol.GetFirstDocument()
While Not ( doc Is Nothing )
If ProcessDocument(doc) Then
iProcessed = iProcessed + 1
Else
iError = iError + 1
End If
Set doc = vCol.GetNextDocument(doc)
Wend
End Sub
'
=================================
=================================
=============
=========
' CheckSelectionFormulaValid - This function
uses the Lotus C API to check the
syntax of a Notes formula.
'
' Return Value: Variant - A 3 elements array
containing:
' Index 0 - The compilation error code or
NO_ERROR (0) if valid
' Index 1 - The compilation error offset in
formula or NO_ERROR if valid
' Index 2 - The compilation error length or
NO_ERROR if valid
'
' Note: The compilation error code at Index 0
can then be passed to GetAPIError
() to get more info about
' the error.
'
===================================
====================================
========
=========
Function CheckSelectionFormulaValid
(sFormula)
As Variant
Dim iError As Integer
Dim hFormula As Long
Dim wFormulaLen As Integer
Dim iCompileError As Integer
Dim iCompileErrorLine As Integer
Dim iCompileErrorColumn As Integer
Dim iCompileErrorOffset As Integer
Dim iCompileErrorLength As Integer
Dim iArray(2) As Integer
iError = NSFFormulaCompile(0, 0, _
sFormula, _
Len(sFormula), _
hFormula, _
wFormulaLen, _
iCompileError, _
iCompileErrorLine, _
iCompileErrorColumn, _
iCompileErrorOffset, _
iCompileErrorLength)
If hFormula <> NULLHANDLE Then
Call OSMemFree(hFormula)
End If
If iError = ERR_FORMULA_COMPILATION Then
iArray(0) = iCompileError
iArray(1) = iCompileErrorOffset
iArray(2) = iCompileErrorLength
CheckSelectionFormulaValid = iArray
Else
iArray(0) = NO_ERROR
iArray(1) = NO_ERROR
iArray(2) = NO_ERROR
CheckSelectionFormulaValid = iArray
End If
End Function
'
===================================
==================================
==========
=========
' GetAPIError - This function uses the Lotus
C API to return a Notes error's
text message.
'
' Return Value: String - The text associated
with the Notes API error code.
'
==================================
==================================
===========
=========
Function GetAPIError(iErrorCode As Integer)
As String
Dim iRetVal As Integer
Dim sError As String * 1024
sError = String(1024, 0)
iRetVal = OSLoadString(0&, iErrorCode,
sError, 1023)
If iRetval <> 0 Then
GetApiError = Left$(sError, iRetVal)
End If
End Function
Do you have comments on this tip? Let us know.
This tip was submitted to the SearchDomino.com tip exchange by member Christian Cloutier. Please let others know how useful it is via the rating scale below. Do you have a useful Notes/Domino tip or code to share? Submit it to our monthly tip contest and you could win a prize and a spot in our Hall of Fame.
