Exploiter un champ Texte Riche

[oguruma]

Etant donné que le sujet est chaud... et de mon côté, je suis confronté également au problème... j'ai donc pris un peu de temps pour me faire une classe capable d'exploiter les objets RichText...
En voici une première version... d'autres suivront...

pour exploiter le contenu d'un champ body tel que celui-ci

21/07/2005 17/01/2005 15:32:53 00165-001 16/06/2005 35 5
21/07/2005 20/01/2005 14:28:42 00178-001 30/06/2005 21 3
21/07/2005 27/01/2005 16:28:05 00206-001 30/06/2005 21 3
21/07/2005 30/05/2005 16:25:48 00455-001 14/06/2005 37 3

[syntax="ls"]
Public Class BodyText
Private m_vText As Variant

Sub new(pDoc As NotesDocument, pField As String)
m_vText=pDoc.GetItemValue(pField)
End Sub

Property Get Text As Variant
Text=m_vText(0)
End Property
End Class

Public Class TextLines
Private m_lines As Variant

Sub new (pText As String)
m_lines=atexplode(pText,Chr$(13)+Chr$(10))
End Sub

Property Get Lines As Variant
Lines=m_lines
End Property

End Class

Public Class LineElements
Private m_elements As Variant

Sub new(e As String, s As String)
m_elements=atExplode(e,s)
End Sub

Property Get Elements As Variant
Elements=m_elements
End Property

End Class

Function atExplode(s As String, div As String) As Variant
On Error Goto handleError
Redim result(0 To 0) As String
Dim i As Integer
Dim pos As Long
Dim oldpos As Long
Dim skip As Long
oldpos = 1
skip = Len(div)
pos = Instr(s, div)
Do Until pos = 0
Redim Preserve result(0 To i+1)
result(i) = Mid$(s, oldpos, pos-oldpos)
i = i + 1
oldpos = pos + skip
pos = Instr(oldpos, s, div)
Loop
result(i) = Mid$(s, oldpos)
atExplode = result
Exit Function
handleError:
Print "Erreur atExplode ";Err;" ";Error$;" ligne ";Erl
Resume fin
fin:
End Function
[/syntax]

Un petit exemple d'utilisation

[syntax="ls"]
Sub Initialize
Dim bt As BodyText
Dim tl As TextLines
Dim le As LineElements
Dim s As New notessession
Dim db As notesdatabase
Dim doc As notesdocument
Dim c As notesdocumentcollection
Dim v, w As Variant
Set db=s.currentdatabase
Set c=db.UnprocessedDocuments
Set doc=c.getfirstdocument
Set bt=New BodyText(doc,"LU_BodyLog")
Msgbox bt.Text
Set tl=New TextLines(bt.Text)
w=tl.Lines
Forall e In w
Msgbox e
Set le=New LineElements(Cstr(e)," ")
v=le.Elements
Forall elem In v
Msgbox elem
End Forall
End Forall
End Sub
[/syntax]

[oguruma]

[syntax="ls"]
Function exportLogExcel()
'//=========================================
'//= Génération de la log au format Excel
'//=========================================
Dim bt As BodyText
Dim tl As TextLines
Dim le As LineElements
Dim user As String
Dim viewLog As NotesView
Dim docLog As NotesDocument
Dim rt As Variant
Dim lignes As Variant
Dim elements As Variant
Dim enregi As String
On Error Goto handleError
Set viewLog=db.GetView("VLOGUSERS")
Set docLog=viewLog.GetfirstDocument
If docLog Is Nothing Then
Msgbox "aucun document à exporter",48
Exit Function
End If
Close
Open "c:\logaction.csv" For Output As 1
While Not (docLog Is Nothing)
Set bt=New BodyText(docLog,"LU_BodyLog")
Set tl=New TextLines(bt.Text)
lignes=tl.Lines
Forall ligne In lignes
If Trim$(ligne)<>"" Then
Set le=New LineElements(Cstr(ligne)," ")
elements=le.Elements
enregi=docLog.LU_Nom(0) & ";" & atImplode(elements,";")
Print enregi
Print #1,enregi
End If
End Forall
Set docLog=viewLog.GetNextDocument(docLog)
Wend
Close
Exit Function
handleError:
Msgbox "Erreur n° " & Err & " - " & Error$ & " - ligne " & Erl,16,"ExportLogExcel"
Resume fin
fin:
End Function
[/syntax]