Zekid : [Ajout signet] Client V6

[Stephane Maillard]

C'est Zekid qui avait fait ce code.

Sub Create_url_Bookmark_Draft

' Récupération du titre de la base
Dim atDbTitle As Variant
atDbTitle = Evaluate("@DbTitle")

' Définition du label du signet avec le titre de la base
Dim labelSignet As String
labelSignet = atDbTitle(0)

' Label des outlines se situant avant le signet que l'on veut mettre
Dim labelBeforeFR As String
Dim labelBeforeUK As String
labelBeforeFR = ""
labelBeforeUK = ""

' Nom de l'image dans la base de bookmark
' et id de l'image dans la base courante
Dim imageTextInBookmark As String
Dim idImageInBaseCourante As String
imageTextInBookmark = "Icone_DMR_PreValidation_Voyage.bmp"
idImageInBaseCourante = "11D2B0CCF15381E8C1256FB9004FD2B5"


' Récupération de la session
Dim session As New NotesSession

' Récupération de la base Courante
Dim dbCourante As NotesDatabase
Set dbCourante = session.CurrentDatabase

' Récupération du nom de serveur
Dim atServerName As Variant
atServerName = Evaluate("@ServerName")

' Récupération de la base des images
Dim imagesDB As NotesDatabase
Set imagesDB = New NotesDatabase( atServerName(0) , "RessourceNotesExanes.nsf" )

' Récupération du bookmark local
Dim dbBookmark As NotesDatabase
Set dbBookmark = New NotesDatabase( "", "bookmark.nsf" )

' Récupération de la outline qui gère les signets de la partiee gauche de Notes
Dim outline As NotesOutline
Set outline = dbBookmark.GetOutline("UserBookmarkOrder")

' Récupération de la première entrée de la Outline(plan)
Dim oeTmp As NotesOutlineEntry
Dim oeRef As NotesOutlineEntry
Set oeTmp = outline.GetFirst()


' Début du traitement , on en gère l'état
Dim done As Boolean
Dim referenceFound As Boolean
Dim nacEntryFound As Boolean

Dim label As String
done = False

' Boucle sur toutes les entrées du plan pour positionner le signet où on veut
' Et surtout pour vérifier qu'il n'est pas déjà là !
Do While Not(done)
If oeTmp Is Nothing Then
done = True
Else
label = oeTmp.Label
If label = labelSignet And oeTmp.Level = 0 Then
nacEntryFound = True
done = True
Else
If (labelBeforeFR<>"" Or labelBeforeUK<>"") And (label=labelBeforeFR Or label=labelBeforeUK) Then
referenceFound = True
Set oeRef = oeTmp
End If
Set oeTmp = outline.GetNextSibling(oeTmp)
End If
End If
Loop



' Si l'entrée a été trouvé , on le précise à l'utilisateur
If nacEntryFound Then
Messagebox "L'icône se trouve déjà sur la barre des signets", MB_OK, "Information !"
Exit Sub
Else

' Création de la nouvelle entrée
Dim oeNew As NotesOutlineEntry
Set oeNew = outline.CreateEntry(labelSignet)
Call oeNew.SetURL(dbCourante.NotesURL)

If referenceFound Then
Call outline.AddEntry(oeNew, oeRef,True,False)
Else
Call outline.AddEntry(oeNew, ,True,False)
End If

oeNew.ImagesText= imageTextInBookmark

Call outline.save()
End If

' Copie de l'icone image dans le bookmark local
Dim imageDocument As NotesDocument
Set imageDocument = dbCourante.GetDocumentByUNID( idImageInBaseCourante )

Dim imageDocumentInBookmark As NotesDocument
Set imageDocumentInBookmark = imageDocument.CopyToDatabase( dbBookmark )
Call imageDocumentInBookmark.ReplaceItemValue("$TITLE",imageTextInBookmark)
Call imageDocumentInBookmark.save(True,True)

Messagebox "L'icône sera visible au prochain démarrage de Lotus Notes.", MB_OK, "Information !"

End Sub