J'ai repris les idées de la classe de Stéphane Maillard et j'en ai fait une classe qui permet de copié un champ rich text d'un document dans le document "About".
- Code : Tout sélectionner
Const wAPIModule = "NNOTES" ' Windows/32
Const NOTE_CLASS_ABOUT = &H8002
Const NOTE_INFO_DB = 0
Const NOTE_INFO_ID = 1
Const NOTE_INFO_OID = 2
Const NOTE_INFO_CLASS = 3
Const NOTE_INFO_FLAGS = 7
Const ITEM_SIGN = 1
Const ITEM_SUMMARY = 4
Const TYPE_TEXT = &H0500
Declare Private Function NSFDbOpen Lib wAPIModule Alias "NSFDbOpen" ( Byval P As String, hDB As Long) As Integer
Declare Private Function NSFDbClose Lib wAPIModule Alias "NSFDbClose" ( Byval hDB As Long) As Integer
Declare Private Function NSFNoteUpdate Lib wAPIModule Alias "NSFNoteUpdate" ( Byval hNT As Long, Byval F As Integer) As Integer
Declare Private Function NSFNoteCreate Lib wAPIModule Alias "NSFNoteCreate" ( Byval hDB As Long, hNT As Long) As Integer
Declare Private Function NSFNoteSetInfo Lib wAPIModule Alias "NSFNoteSetInfo" ( Byval hNT As Long, Byval M As Integer, V As Any) As Integer
Declare Private Function NSFNoteSign Lib wAPIModule Alias "NSFNoteSign" ( Byval hNT As Long) As Integer
Declare Private Function NSFItemSetTextSummary Lib wAPIModule Alias "NSFItemSetText"( Byval hNT As Long, Byval N As String, Byval T As String, Byval nT As Integer, Byval S As Integer) As Integer
Declare Private Function NSFItemAppend Lib wAPIModule Alias "NSFItemAppend" ( Byval hNT As Long, Byval F As Integer, Byval N As String, Byval nN As Integer , Byval T As Integer, Byval V As String, Byval nV As Long) As Integer
Declare Private Function OSPathNetConstruct Lib wAPIModule Alias "OSPathNetConstruct" ( Byval NullPort As Long, Byval Server As String, Byval FIle As String, Byval PathNet As String) As Integer
Declare Sub NEMDisplayError Lib "NNOTESWS" Alias "NEMDisplayError" ( Byval E As Long)
Private Const ABOUT = "FFFF0002"
Private Const FIELDBODY = "$Body"
Private Const View_AboutDocument = "($AboutDocument)"
Public Class CreateAboutDocument
Private m_se As NotesSession
Private m_db As NotesDatabase
Private m_dbOpen As NotesDatabase
Private m_docAbout As NotesDocument
Private m_docUsingDB As NotesDocument
Private m_doc As NotesDocument
Private m_body As NotesRichTextItem
Private m_view As NotesView
'/**
' * @version 1.0
' * @param nothing
' * @return nothing
' */
Sub new
Set m_se = New NotesSession
Set m_db = m_se.CurrentDatabase
End Sub
'/**
' * @version 1.0
' * @param nothing
' * @return NotesDocument
' */
Public Function CreateDocAbout(pserver As String,pFile As String) As Notesdocument
Dim hDB As Long, hNT As Long
Dim np As String
Dim db As New NotesDatabase(pServer,pFile)
Set m_dbOpen = db
If m_dbOpen.IsOpen = True Then
Set m_docAbout = m_dbOpen.GetDocumentByID(ABOUT)
If (m_docAbout Is Nothing) Then
np = Space(1024)
OSPathNetConstruct 0, m_dbOpen.Server, m_dbOpen.FilePath, np
NSFDbOpen np, hDB
NSFNoteCreate hDB, hNT
NSFNoteSetInfo hNT, NOTE_INFO_CLASS, NOTE_CLASS_ABOUT
NSFNoteUpdate hNT, 0
NSFDbClose hDB
Set m_docAbout = m_dbOpen.GetDocumentByID(ABOUT)
Set CreateDocAbout = m_docAbout
Else
Call m_docAbout.RemoveItem(FIELDBODY)
Set CreateDocAbout = m_docAbout
End If
Else
Msgbox "La base "+pFile+" n'a pas pu être ouverte !",16,"Erreur"
End If
End Function
'/**
' * @version 1.0
' * @param nothing
' * @return nothing
' */
Public Sub CreateRichTextDocAbout
Dim rtitem As Variant
Set m_view = m_db.GetView(View_AboutDocument)
Set m_doc = m_view.GetFirstDocument
If Not (m_doc Is Nothing) Then
Set rtitem = m_doc.GetFirstItem("TestRich")
Set m_body = m_docAbout.CreateRichTextItem(FIELDBODY)
Call m_body.AppendRTItem(rtitem)
Call m_docAbout.Sign
Call m_docAbout.Save(True, False)
Else
Msgbox "Le document n'existe pas",16,"Erreur"
End If
End Sub
End Class