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