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.
By submitting your email address, you agree to receive emails regarding relevant topic offers from TechTarget and its partners. You can withdraw your consent at any time. Contact TechTarget at 275 Grove Street, Newton, MA.
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