[LotusNotes]小工具: ReplaceField

peterli

自己做的一个小工具, 用来批量修改多个文档的某个域.

用法: 创建一个按钮(Action)
Call ReplaceField

下面是函数库的代码

Function ReplaceField
        ' This Function only work at Client UI
        Dim ws As New NotesUIWorkspace
        Dim uiview As NotesUIView
        Dim dc As NotesDocumentCollection
        Dim doc As NotesDocument
        Dim s As New NotesSession
        Dim db As NotesDatabase
        Dim Fm As NotesForm
        Dim FieldName As String
        Dim OldV As String
        Dim NewV As String
        Redim fields(0)
        Dim F As Variant
       
        Set db=s.CurrentDatabase
        Set uiview=ws.CurrentView
        Set dc=uiview.Documents
        If dc.Count=0 Then
                Msgbox "Please select one document at least."
                Exit Function
        End If
        Set doc=dc.GetFirstDocument
        t=0
        Forall i In doc.Items
                Fields(t)=i.name
                t=t+1
                Redim Preserve Fields(t)
        End Forall
        Redim Preserve Fields(t-1)
        F=Fields
        F=ArraySort(F)
        FieldName=ws.Prompt(4,"Please select Field Name","field name","",F)
        If FieldName="" Then Exit Function
        OldV=Inputbox("Please input Old Value","",doc.GetItemValue(FieldName)(0))
        NewV=Inputbox("Please input New Value","",doc.GetItemValue(FieldName)(0))
        If ws.Prompt(2,"Please Confirm","Are you Sure Replace"+Chr(10)+"Field: "+FieldName+Chr(10)+"Old Value: "+OldV+Chr(10)+"New Value: "+NewV+Chr(10)+"Selected Documents: "+Cstr(dc.Count)) Then
                Set doc=dc.GetFirstDocument
                While Not doc Is Nothing
                        VA=doc.GetItemValue(FieldName)
                        If VA(0)=OldV Then
                                Set item=doc.ReplaceItemValue(FieldName,NewV)
                                Call doc.Save(False,False)
                        End If
                        Set doc=dc.GetNextDocument(doc)
                Wend
        End If
        Call uiview.DeselectAll
End Function

因为LotusR6没有提供ArraySort功能,自己只好做一个.

Function ArraySort(Arr As Variant)
        Dim S As String
        Dim V As Variant
        Dim I As Integer
        Dim J As Integer
       
        V=Arr
        For I=0 To Ubound(V)
                For J=I+1 To Ubound(V)
                        If V(I)>V(J) Then
                                S=V(I)
                                V(I)=V(J)
                                V(J)=S
                        End If
                Next
        Next
        ArraySort=V
       
End Function

peterli

老兄，这个代码是给Lotus Notes用的。再R6.5下测试通过。R5没有试过，估计可用。

星空

什么来的,没有看明白