动态修改视图公式

　　项目中可能经常遇到，按日期时间过滤文档的需求。但是，含有类似@today选择公式的视图，极大地影响了服务器性能。一般的解决方法有写代理轮循、视图按日期时间分类等，这里有个比较好的方法，用定时代理直接修改视图公式，即减少了性能开销，而且能方便地兼容原有数据库。为了便于后期维护，最好在相应视图注释下，某个代理会修改此视图公式。　　　

 

'Update 'Today' in Views:
%REM

Purpose: 'Update views relying on today's date
'If additional views are required, add to views List
'Ensure any column formula including "today:=" does not have line breaks and has the correct case

Originated: PW v2.0 15/06/07

Process: Loop through the views in views List, loop through the columns, if @Contains("today:="),
replace that date of format dd/mm/yyyy with today's date
%END REM
Sub Initialize
Dim s As New NotesSession
Dim adminp As NotesAdministrationProcess
Dim thisdb As NotesDatabase
Dim updateView As NotesView
Dim todaydate As String, formula As String
Dim views List As String
Dim instrPos As Long

On Error Goto logErr

views("vwleadertodayplan") = "vwleadertodayplan"

Set thisdb = s.CurrentDatabase
todayDate = Format(Today(), "yyyy/mm/dd")
Forall viewName In views 'Loop through views
Set updateView = thisdb.GetView(viewName)
formula = updateView.SelectionFormula
instrPos = Instr(formula, "today:=")
If instrPos > 0 Then
Mid$ (formula, InstrPos + 8, 10) = todayDate
updateView.SelectionFormula = formula
End If

Set updateView = thisdb.GetView(viewName)
If Not updateView Is Nothing Then
Forall vc In updateView.Columns 'Loop through columns
If vc.IsFormula Then
formula = vc.Formula
instrPos = Instr(formula, "today:=")
If instrPos > 0 Then
Mid$ (formula, InstrPos + 8, 10) = todayDate
vc.Formula = formula
End If
End If
End Forall
Call updateView.Refresh()
End If

End Forall

'Now we need to sign the database - otherwise the design element is signed with No Signature!
Set adminp = s.CreateAdministrationProcess(thisdb.Server)
Call adminp.SignDatabaseWithServerID(thisdb.Server, thisdb.FilePath, False)

quit:
Erase views 'Cleanup memory from the list
Exit Sub

logErr:
showerror("Initialize")
Resume quit
End Sub

 

 

转载于:https://www.cnblogs.com/Zhang-T/archive/2010/04/02/1703466.html