[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
'/***************************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/,如需轉載,請註明出處,否則將追究法律責任。
相關文章
- 【自然框架】許可權的視訊演示(二):許可權到欄位、許可權到記錄框架
- 對定義者許可權和呼叫者許可權的理解
- 【自然框架】之通用許可權(八):許可權到欄位(列表、表單、查詢)框架
- Oracle中定義者許可權和呼叫者許可權案例分析Oracle
- 對關鍵信貸控制欄位設定許可權
- mysql 給了使用者所有許可權ALL PRIVILEGES,但是該使用者沒有grant許可權MySql
- mysql使用者和許可權MySql
- oracle 使用者的只讀許可權Oracle
- [LotusScript] 重新整理一般人員的ACL許可權
- MySql給賬戶所有許可權MySql
- Oracle 使用者、物件許可權、系統許可權Oracle物件
- linux 檔案許可權 s 許可權和 t 許可權解析Linux
- LightDB/PostgreSQL標準業務建立語句【賦予讀寫許可權和只讀許可權】SQL
- 【SCRIPTS】將使用者具有的所有許可權盡收眼底
- 【許可權管理】Oracle中檢視、回收使用者許可權Oracle
- 使用者許可權繼承另一使用者的許可權繼承
- Android系統許可權和root許可權Android
- 批量修改資料夾及檔案使用者許可權和使用者組許可權 centosCentOS
- 儲存過程,角色相關的呼叫者許可權和定義者許可權問題儲存過程
- 呼叫者許可權與定義者許可權的pl/sql子程式SQL
- mysql 命令列安裝並給使用者sa所有許可權MySql命令列
- js 許可權二進位制JS
- oracle使用者許可權Oracle
- mysql使用者許可權MySql
- oracle 使用者許可權Oracle
- 選單許可權和按鈕許可權設定
- mysql 使用者管理和許可權設定MySql
- 學習筆記 使用者和許可權筆記
- Oracle 定義者許可權與呼叫者許可權(AUTHID CURRENT_USER)Oracle
- MSSQL 如何匯出db所有使用者許可權建立語句SQL
- MongoDB4.0建立自定義許可權(只有查詢,插入和更新的許可權)的角色步驟MongoDB
- SharePoint JavaScript 更新使用者和組欄位JavaScript
- Oracle的物件許可權、角色許可權、系統許可權Oracle物件
- 提取使用者許可權或是不同資料庫使用者許可權的同步資料庫
- 查詢mysql資料庫中所有使用者及使用者許可權MySql資料庫
- Oracle 使用者許可權管理與常用許可權資料字典列表Oracle
- mysql使用者許可權管理MySql
- 使用者物件許可權管理物件