2013年12月4日 星期三

[AP] check RTF field

'//check RTF field

△當ACL設定中 □Replicate or copy documents 沒勾時,做了文件暫存
則會產生「$KeepPrivate = "1"」的欄位
則此欄位就不能做copy的動作

●方式五
要記得確認ACL設定中 □Replicate or copy documents 要勾起。
在主function上的使用:
If ChkIsRTFNull("ATH_8") = True Then Call SP_GotoField(pws, "ATH_8") : Error 997, "矯正措施, 其狀態為Done的項目" & Chr(10) & "Error: 請填寫矯正措施 - 權責部門改善附檔!!"

ChkIsRTFNull則是:
Function ChkIsRTFNull(rtfield As String) As Integer
On Error Goto Errhandle

Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Set uidoc = workspace.CurrentDocument

'Call uidoc.ExpandAllSections 用於有小節的部份

'移到指定的欄位
Call uidoc.GotoField(rtfield)

'欄位選取
Call uidoc.SelectAll

'因當欄位沒有資料可選取取消時,會產生4407的錯誤
Call uidoc.DeselectAll

ChkIsRTFNull = False

Exit Function

Errhandle:
Select Case Err
Case 4407
ChkIsRTFNull = True
Exit Function
Case Else
Error Err
End Select 
End Function


●方式二
Function IsRTFNull(rtfield As String) As Integer
On Error Goto Errhandle

Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Set uidoc = workspace.CurrentDocument

'Call uidoc.ExpandAllSections 用於有小節的部份

'移到指定的欄位
Call uidoc.GotoField(rtfield)

'欄位選取
Call uidoc.SelectAll

'因當欄位沒有資料可選取取消時,會產生4407的錯誤
Call uidoc.DeselectAll

IsRTFNull = False

Exit Function

Errhandle:
Select Case Err
Case 4407
IsRTFNull = True
Exit Function
Case Else
Error Err
End Select 

End Function


●方式三
Function IsrtfMT (doc As Notesdocument , FieldName As String) As Integer
' This function checks if a rich text field is empty

Dim mbdcount As Integer,plaintext As String
Dim rtitem As Variant
mbdcount =0 ' initialize
Set rtitem = doc.GetFirstItem(fieldname)
If ( rtitem.Type = RICHTEXT ) Then
plainText = rtitem.GetFormattedText( False, 0 ) ' render the Rich item into text this gets all text values and ignores attachments/OLE
If Len(plaintext) < 1 Then

If Isarray(rtitem.EmbeddedObjects) Then
Forall o In rtitem.EmbeddedObjects ' loop through array of embedded objects in the rich text item
mbdcount=mbdcount+1 ' there is at least one emb object
End Forall
End If
End If
End If

If (mbdcount + Len(plaintext)) < 1 Then ' if there are no embedded objects AND there is no text also
IsrtfMT=1 ' return flag to calling string RTF IS EMPTY
Else
IsrtfMT=0 ' return flag to calling string RTF IS NOT EMPTY
End If


End Function


●方式四
Function SP_IsRTFNull(ws As Variant,rtfield As String,ExpandSections As Boolean   ) As Integer
'╒═════════════════════════════════════╕
'│程式庫名稱:SP_IsRTFNull 
'╞═════════════════════════════════════╡
'│功    能: 檢查指定欄位是否為空值(有文字、附檔、Doc. Link都算是有值) 
'│參    數: ws      UI Workspace            傳 回 值: RT欄位是否為空值 
'│   rtfield 欲檢查的欄位名稱              
'│   ExpandSections 是否展開小節後再檢查      
'╘═════════════════════════════════════╛
On Error Goto Errhandle1
SP_IsRTFNull = False '預設回傳值
If ws Is Nothing Then Exit Function '當未傳入ws ,則可能是在Domino Server上執行,則不再檢查
Dim uidoc As NotesUIDocument
Dim currentfield As String
Set uidoc = ws.CurrentDocument
If uidoc Is Nothing Then Exit Function
If Not uidoc.EditMode Then Exit Function '非編輯模式也不檢查
currentfield = uidoc.CurrentField
'This is only needed if your field is in a section that may be closed when this executes
If ExpandSections Then Call uidoc.ExpandAllSections
Call uidoc.GotoField(rtfield)
Call uidoc.SelectAll

'The next line will generate a 4407 error message if the Rich Text Field is null
On Error Goto Errhandle2
Call uidoc.DeselectAll
TheEnd:
If currentfield <> "" Then
Call uidoc.GotoField(currentfield)
End If
Exit Function
Errhandle1:
' Call SP_ErrorBox("SP_IsRTFNull Function")     
Resume TheEnd          
Errhandle2:
'the DeselectAll line generated an error message, indicating that the rich text field does not contain anything
If Err = 4407 Then SP_IsRTFNull = True
' Call SP_ErrorBox("Library:SP.wfLibV2-SP_IsRTFNull()")     
Resume TheEnd

End Function

沒有留言:

張貼留言