[LotusScript] 更新所有讀者和作者權限欄位

Sub Initialize
 '/***************************Created by With on 2011/05/31***************************/
 Dim session As New NotesSession
 Dim db, Adb As NotesDatabase
 Dim collection As NotesDocumentCollection
 Dim doc As NotesDocument
 Dim tempInfo, Etemp As Variant
 Dim entry As NotesViewEntry
 Dim view As NotesView
 Dim i, j, k, l As Integer
 Dim newValue As String
 Dim infoArray(), ReadersArray(), EditorsArray() As String
 Dim msg, ReaderList, EditorList As String
 
 HaveRight = Evaluate( |@Contains(@UserRoles;"[SystemManagers]")|) 
 If HaveRight(0) = 0 Then
  Msgbox "你無權執行此動作",48,"提示"
  Exit Sub
 End If
 
 startTime = Cstr(Today)
 
 Set db = session.CurrentDatabase
 Set collection = db.UnprocessedDocuments    
 Set Adb = New NotesDatabase(db.server, "SYSTEM\UGOP.nsf")
 Set view=Adb.GetView("(ByOldEName)") 
 
 '/***************獲取當前文檔所有的讀者和作者欄位名稱 Begin***************/
 Set doc = collection.GetFirstDocument
 msg = "當前文檔("+doc.form(0)+")所有的讀者和作者欄位名稱如下："+Chr(10)
 ReaderList = Chr(10) + "讀者欄位名稱："
 EditorList = Chr(10) + "作者欄位名稱："
 k = 0
 l = 0
 Forall item In doc.Items
  If item.IsReaders Then
   'ReaderList = ReaderList + item.name + Chr(10)
   If Right(item.name, 4) <> "_bak" Then
    Redim Preserve ReadersArray(k)
    ReadersArray(k) = item.name
    k = k + 1
   End If
  End If
  If item.IsAuthors Then
   'EditorList = EditorList + item.name + Chr(10)
   If Right(item.name, 4) <> "_bak" Then
    Redim Preserve EditorsArray(l)
    EditorsArray(l) = item.name
    l = l + 1
   End If
  End If
 End Forall
 'Msgbox msg + ReaderList + EditorList
 '/***************獲取當前文檔所有的讀者和作者欄位名稱 End*****************/
 
 'If Ubound(ReadersArray) = 0 And Ubound(EditorsArray) = 0 Then
 If k = 0 And l = 0 Then
  Exit Sub
 End If
 
 For i = 1 To collection.Count
  Set doc = collection.GetNthDocument( i )
  
  '/*****************處理表單上所有的讀者欄位 開始**************/
  Forall ReaderFieldName In ReadersArray
   tempInfo = doc.GetItemValue(ReaderFieldName)
   j = 0
   Forall m In tempInfo
    Redim Preserve infoArray(j)
    Etemp = Evaluate( {@Name([Abbreviate];"}+m+{")})
    tempName = Etemp(0)
    Set entry = view.GetEntryByKey(tempName)
    
    If entry Is Nothing Then 
     infoArray(j) = m '若找不到,說明此人已經離職或者是其mail有變更再或者其值是角色,保留原值
    Else
     'tempFullName = Evaluate( {@Name([Canonicalize];"}+entry.ColumnValues(3)+{")})
     'newValue = entry.ColumnValues(3)
     newValue = entry.Document.NotesFullName(0)
     infoArray(j) = newValue
    End If
    j = j + 1
   End Forall
   '是否將原始值backup，值得考慮
   If Not doc.HasItem(ReaderFieldName+"_bak") Then Call doc.ReplaceItemValue(ReaderFieldName+"_bak", tempInfo)
   
   Call doc.ReplaceItemValue(ReaderFieldName, infoArray)
  End Forall
  '/*****************處理表單上所有的讀者欄位 結束**************/
  
  '/*****************處理表單上所有的作者欄位 開始**************/
  Forall EditorFieldName In EditorsArray
   tempInfo = doc.GetItemValue(EditorFieldName)
   j = 0
   Forall m In tempInfo
    Redim Preserve infoArray(j)
    
    Etemp = Evaluate( {@Name([Abbreviate];"}+m+{")})
    tempName = Etemp(0)
    Set entry = view.GetEntryByKey(tempName)
    
    If entry Is Nothing Then 
     infoArray(j) = m '若找不到,說明此人已經離職或者是其mail有變更再或者是其值是角色，故保留原值
    Else
     'tempFullName = Evaluate( {@Name([Canonicalize];"}+entry.ColumnValues(3)+{")})
     'newValue = entry.ColumnValues(3)
     newValue = entry.Document.NotesFullName(0)
     infoArray(j) = newValue
    End If
    
    j = j + 1
   End Forall
   '是否將原始值backup，值得考慮
   If Not doc.HasItem(EditorFieldName+"_bak") Then Call doc.ReplaceItemValue(EditorFieldName+"_bak", tempInfo)
   
   Call doc.ReplaceItemValue(EditorFieldName, infoArray)
  End Forall
  '/*****************處理表單上所有的作者欄位 結束**************/
  
  'Call doc.ComputeWithForm(False,False) '需要更新表單的其它計算欄位
  Call doc.save(True,False) 
 Next
 
 ' 發送郵件
 Msgbox "更新子單的所有讀者和作者欄位成功！"
 Set mdoc=db.createdocument
 Set rtitem=New notesrichtextitem(mdoc,"Body")
 mdoc.Form="memo"
 mdoc.sendto= "With Wang/CN/CMINL"
 mdoc.subject=Cstr(Today)+" Domain Change"+db.server
 Call  rtitem.AppendText(Cstr(db.title)+"更新子單的所有讀者和作者欄位成功 !")
 Call  rtitem.AddNewLine(1)
 Call  rtitem.AppendText("子單數量共"+Cstr(collection.Count))
 Call  rtitem.AddNewLine(1)
 Call  rtitem.AppendText("開始時間  "+Cstr(startTime))
 Call  rtitem.AddNewLine(1)
 Call  rtitem.AppendText("結束時間  "+Cstr(Today))
 Call  rtitem.AddNewLine(1)
 Call rtitem.AppendText( ErrorMsg )
 mdoc.send(False)
 '出錯處理
 '無
End Sub

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/24998103/viewspace-700383/，如需转载，请注明出处，否则将追究法律责任。