DominoArea.org [Archive]

Salut,

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