effacer tout le contenu du champ texte riche

[lcoder]

Bonjour,

Je suis entrain de creer un agent qui ajout / supprime / modifie des info dans des documents ...

mais les documents en question contiennent un champ texte riche ...
et plutot que de le modifier, je souhaite effacer tout le contenu du champ
pour inscrire un nouveau contenu ...

mais je n ai pas trouver de fonction permettant d effacer un texte riche !
Avez vous une solution ?

merci

[Michael DELIQUE]

salut

essais ça

Code : Tout sélectionner

Sub ItemCleanUp(wvrItem As Variant, wDoc As NotesDocument, wvrArray As Variant)
   REM efface un champ par suppression / recreation
   REM car dans certain cas le item.values = null pose souci
   
   Dim DocParent As NotesDocument
   Dim NameItem As String
   Dim nbTypeItem As Long
   Dim lstItem List As Boolean
   Dim nbData As Boolean
   Dim vrEO As Variant
   Dim nbAsString As Boolean
   Dim EMObject As NotesEmbeddedObject
   
   On Error GoTo CatchError
   
   nbAsString = False
   
   Select Case DataType(wvrItem)
   Case 0,1,9,10
      rem EMPTY,NULL,OLE object or NOTHING
      Error 9999,"wItem is Empty"
      Exit Sub
   Case 8
      rem string   
      nbAsString = True
      If Trim(CStr(wvrItem)) = "" Then
         Error 9999,"wItem is Empty"
         Exit Sub
      End If
      If wDoc Is Nothing Then
         Error 9999,"wDoc Is Nothing"
         Exit Sub
      ElseIf wDoc.hasItem(Trim(CStr(wvrItem))) = False Then
         Error 9999,"Field '"+Trim(CStr(wvrItem))+"' Not Found"
         Exit Sub
      End If
      Set wvrItem = wDoc.GetFirstItem(Trim(CStr(wvrItem)))
      Set DocParent = wDoc
   Case Else
      Select Case UCase(Trim(TypeName(wvrItem)))
      Case "NOTESITEM", "NOTESRICHTEXTITEM"
         Set DocParent = wvrItem.Parent
         If DocParent Is Nothing Then
            Error 9999,"wvrItem Parent Document is Nothing"
            Exit Sub
         End If   
      Case Else
         Error 9999,"Bad DataType ("+CStr(DataType(wvrItem))+") : "+Trim(TypeName(wvrItem))               
      End Select
   End Select
   
   Select Case DataType(wvrArray)
   Case 0,1,9,10
      REM  EMPTY,NULL,OLE object or NOTHING
      nbData = False
   Case 2,3,4,5,6,8
      nbData = True
   Case Else
      nbData = IsArray(wvrArray)
   End Select   
   
   NameItem = Trim(wvrItem.Name)
   If Trim(NameItem) = "" Then
      Error 9999,"NameItem is Empty"
      Exit Sub
   End If
   
   nbTypeItem = wvrItem.Type
   If nbTypeItem < 1 Then
      Error 9999, "Item : "+NameItem+", Bad Type : "+Cstr(nbTypeItem)
      Exit Sub
   End If
   
   lstItem("IsAuthors") = wvrItem.IsAuthors
   lstItem("IsEncrypted") = wvrItem.IsEncrypted
   lstItem("IsNames") = wvrItem.IsNames
   lstItem("IsProtected") = wvrItem.IsProtected
   lstItem("IsReaders") = wvrItem.IsReaders
   lstItem("IsSigned") = wvrItem.IsSigned
   lstItem("IsSummary") = wvrItem.IsSummary
   
   Select Case nbTypeItem
   Case 1
      REM richText
      If Not wvrItem Is Nothing Then
         vrEO = wvrItem.EmbeddedObjects
         If testVariant(vrEO) = True Then
            ForAll Attachement In vrEO
               Set EMObject =  Attachement
               If Not EMObject Is Nothing Then
                  If EMObject.Type = EMBED_ATTACHMENT Then
                     Call EMObject.remove
                  End If
                  Set EMObject = Nothing
               End If               
            End ForAll
            vrEO = Null
         End If
      End If
      
      wvrItem.Values = Null
      Call wvrItem.Remove()
      Set wvrItem = Nothing
      
      Set wvrItem = New NotesRichTextItem(DocParent,NameItem)
      If nbData = True Then
         If Not wvrItem Is Nothing Then
            wvrItem.values = wvrArray
         End If   
      End If

   Case 1074,1076,1075
      REM nom, lecteur, auteur
      
      wvrItem.Values = Null
      Call wvrItem.Remove()
      Set wvrItem = Nothing
      
      If nbData = False Then
         Set wvrItem = New NotesItem(DocParent,NameItem,"",nbTypeItem)
      Else
         Set wvrItem = New NotesItem(DocParent,NameItem,wvrArray,nbTypeItem)
      End If
   Case Else
      REM autre type
      
      wvrItem.Values = Null
      Call wvrItem.Remove()
      Set wvrItem = Nothing
      
      If nbData = False Then
         Set wvrItem = New NotesItem(DocParent,NameItem,"")
      Else
         Set wvrItem = New NotesItem(DocParent,NameItem,wvrArray)
      End If
   End Select
   
   wvrItem.IsAuthors = lstItem("IsAuthors")
   wvrItem.IsEncrypted = lstItem("IsEncrypted")
   wvrItem.IsNames = lstItem("IsNames")
   wvrItem.IsProtected = lstItem("IsProtected")
   wvrItem.IsReaders = lstItem("IsReaders")
   wvrItem.IsSigned = lstItem("IsSigned")
   wvrItem.IsSummary = lstItem("IsSummary")
   
   Set DocParent = Nothing
   
   If nbAsString = True Then
      Set wvrItem = Nothing
      wvrItem = NameItem
   End If
   
   Erase lstItem
   
   Exit Sub
CatchError:
   MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   Set DocParent = Nothing
   Erase lstItem
   Exit Sub
End Sub