Remplacer une chaîne de caractères dans un richtext (MIME)

[mike76]

Bonjour,

Je dois remplacer une chaîne par une autre chaîne dans un richtext en Back-End.
J'ai regardé ce post qui correspondait à ce que je voulais :
http://www.dominoarea.org/forum/viewtopic.php?t=19614&search_id=531066623

Mon problème est que mon champ est au format MIME donc ça plante à la ligne :

Code : Tout sélectionner

Set nrtn = gRTItem.CreateNavigator

Message : "Instance a member CREATNAVIGATOR does not exist"
A mon avis c'est normal comme le champ n'est pas au format texte riche mais MIME.

Voici mon code, si vous avez une idée comment je peux le modifier pour que ça fonctionne :

Code : Tout sélectionner

Dim gRTItem As Variant

Sub Initialize()
   Dim session As New NotesSession
   Dim db As NotesDatabase
   Dim collection As NotesDocumentCollection
   Dim doc As NotesDocument
   
      
   session.Convertmime=false

   Set db=session.CurrentDatabase
   Set collection=db.Search({Form="Emailing"}, nothing, 0)
   Set doc=collection.Getfirstdocument()
   
   ForAll item In doc.Items   
         If item.Type = 25 Then
            Set gRTItem = doc.getfirstitem(item.name)
            If item.Name="Body" then
               Call ReplaceRichText("titi","toto")
            End if
         End If
    End ForAll   

   Call doc.Save(True,False)
   
   session.Convertmime=true
End Sub

Sub ReplaceRichText(ByVal p_ValueBefore As String, ByVal p_ValueAfter As String)

   Dim nrtn As NotesRichTextNavigator
   Dim nrtr As NotesRichTextRange
   Dim i As Integer
   
   
   ' make sure "ValueAfter" has a value
   If p_ValueAfter = "" Then
      p_ValueAfter = " "
   End If
   
   Set nrtn = gRTItem.CreateNavigator
   Set nrtr = gRTItem.CreateRange
   
   ' Find the 1st paragraph
   If nrtn.FindFirstElement(4) Then
      Call nrtr.SetBegin(nrtn)
      
      ' Replace each instance
      While nrtr.FindAndReplace(p_ValueBefore, p_ValueAfter, 1)
         Set nrtr = gRTItem.CreateRange
         Call nrtn.FindFirstElement(4)
         Call nrtr.SetBegin(nrtn)
      Wend
   End If

End Sub


Merci d'avance.

[mike76]

Voici le code si ça peut aider quelqu'un:

Code : Tout sélectionner

Sub Initialize()

   Dim session As New NotesSession
   Dim db As NotesDatabase
   Dim collection As NotesDocumentCollection
   Dim doc As NotesDocument
   Dim stream As NotesStream
   Dim mime As NotesMIMEEntity
   Dim body As variant
   Dim chaine As String
      
   session.Convertmime=False
   
   Set db=session.CurrentDatabase
   Set collection=db.Search({Form="Emailing"}, Nothing, 0)
   Set doc=collection.Getfirstdocument()
   Set body = doc.GetFirstItem("Body")
   
   If body.Type = MIME_PART Then
      Set mime = body.GetMimeEntity
      Set stream = session.CreateStream
      
      chaine=ReplaceSubstring(mime.ContentAsText,"TITI","TOTO")
        Call stream.WriteText(chaine)

        Call mime.SetContentFromText(stream, mime.Contenttype + "/" + mime.Contentsubtype + ";charset=" + mime.Charset, mime.Encoding)
      Call doc.Save(True,False)
   End if
   
   session.Convertmime=True
   
End Sub

Function ReplaceSubstring (chaine As String, oldString As Variant, newString As Variant) As String
   Dim texte As String
   
   texte = Replace(chaine, oldString, newString)
   
   ReplaceSubstring = texte
End Function

je vais mettre ça dans les Tips

[Michael DELIQUE]

salut

il ya maintenant la fonction replace native en Lotus Script

[mike76]

salut Michaël

Effectivement j'avais oublié,
je modifie de suite mon code dans le tip
a+