Appending embedded attachments in a document into a richtext field
Appending embedded attachments in a document into a richtext field
In one of my projects, the user is allowed to attach files into a document using file-upload control. But while saving the document, it is required to append the embedded files into a richtext field in that document. To achieve that I came up with the following code.
This function is used to append the attachments embedded in a document into a richtext field. It is little bit lengthy but very useful.
The function to append attachments into RTF:
Function AppendDocAttachmentsToRTF(docAttach As NotesDocument, rtfStore As Variant) As Integer ' Author : C.Saravanan, Cybernet Software Systems Pvt. Ltd., India. ' Purpose : To append the embedded attachments in a document into a richtext field. ' Parameters: ' 1. docAttach - document from which the embedded attachments are stored. ' 2. rtfStore - Richtext field to which the attachments will be stored. ' Returns: ' The number of attachments appended to the richtext field. Const PARAM_FILE = "$File" Dim objAttach As NotesEmbeddedObject Dim strFilePath As String Dim varAttachNames As Variant Dim intAttachCount As Integer intAttachCount = 0 ' Exception handling If docAttach Is Nothing Then Goto Exit_Function If docAttach.HasEmbedded Then ' The document really has embedded objects... Set varAttachNames = docAttach.GetFirstItem(PARAM_FILE) While Not varAttachNames Is Nothing Forall Attach In varAttachNames.Values ' for all attachments in the current attach object ' getting the attachment object using the attachment name Set objAttach = docAttach.GetAttachment(Attach) ' exception handling If objAttach Is Nothing Then Goto Exit_Function If objAttach.Type = EMBED_ATTACHMENT Then ' The attachment object type is embedded attachment strFilePath = Curdrive() + "" + objAttach.Name Call objAttach.ExtractFile( strFilePath) Call rtfStore.EmbedObject(EMBED_ATTACHMENT, "", strFilePath) Kill(strFilePath) intAttachCount = intAttachCount + 1 End If objAttach.Remove End Forall '
Remove the current attachment field from the document, so that the next attachment field can be retrieved if exists...
Call varAttachNames.Remove Set varAttachNames = docAttach.GetFirstItem(PARAM_FILE) Wend End If Exit_Function: AppendDocAttachmentsToRTF = intAttachCount End Function
' Sample code to use the function. ' This code can be written in a view action button
Dim session As New notessession Dim db As notesdatabase Dim dc As notesdocumentcollection Dim doc As notesdocument Dim rtfBody As Variant Dim Count As Integer Set db = session.currentdatabase Set dc = db.unprocesseddocuments Set doc = dc.getfirstdocument While Not doc Is Nothing Set rtfBody = doc.getfirstitem("Body") If rtfBody.Type = RICHTEXT Then Count = AppendDocAttachmentsToRTF(doc,rtfBody) End If Call doc.save(True,False) Set doc = dc.getnextdocument(doc) Wend