LotusScript处理RTF域中特殊字符

Option Public

%REM

『函数功能』替换富文本域Body中所有"/weboa/wboardzhinfo.nsf/"字符串为"/2014/2014wboardzhinfo.nsf/"

strSource 将要被处理的字符串

strFrom 查找的目标子字符串

strTo 查找对象将被替换成这个子字符串

%END REM

Sub Initialize

On Error GoTo E

Dim s As New NotesSession

Dim db As NotesDatabase

Dim view As NotesView

Dim dc As NotesDocumentCollection

Dim doc As NotesDocument

Dim item As NotesItem

Dim strTmp, strResult As String

Dim strSource As String'将要被处理的字符串

Dim strFrom As String'查找的目标子字符串

Dim strTo As String'查找对象将被替换成这个子字符串

Dim i, iCount, iBase As Double

Dim tmp As Variant

Set db = s.Currentdatabase

Set view = db.Getview("vwAllDoc")

Set doc = view.GetFirstDocument

iBase = 1000

strFrom="weboa/wboardzhinfo.nsf"

'strTo="/2014/2014wboardzhinfo.nsf/"

strTo=Replace(db.Filepath, "\", "/")

On Error Resume next

While Not(doc Is Nothing) '处理域中特殊字符

strResult = ""

Set item=doc.GetFirstItem("Body")

strSource = item.Text

iCount = Len(strSource)

For i=0To CInt(iCount/iBase)+1

strTmp = ""

If (iBase*i+1

If (iBase*i+iBase>iCount) Then

strTmp = Mid(strSource,iBase*i+1, iCount-iBase*i)

Else

strTmp = Mid(strSource,iBase*i+1, iBase)

End If

tmp = Evaluate(|@replacesubstring('|+strTmp+|';@NewLine;'')|)

strResult =strResult + tmp(0)

End If

Next

If (strResult<>"") Then

doc.Body=Replace(strResult,strFrom,strTo) '替换域中字符串

Call doc.Save(1, 1)

End If

MsgBox"aaaaaaaaaaa:" & CStr(doc.Universalid)

Set doc = view.GetNextDocument(doc)

Wend

Exit sub

E:

str1="agUpdateBodyForMIGSrc代理发生错误:第"+Cstr(Erl)+"行"+Error MsgBox str1

End Sub

Sub Terminate

End Sub