Is there any method of adding images or unicode characters from (say) Wingdings by in a table generated by lotusscript.
As the options for formatting of tables in lotusscript are limited I store a formatted table in a profile document and append it to the rich text field.
In the Queryopen event of the document I add the rtf table and add rows and populate. The one below is finding emails sent from a document and displaying them in that document in an RTF
Any help is greatly appreciated.
Sub Queryopen(Source As Notesuidocument, Mode As Integer, Isnewdoc As Variant, Continue As Variant)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim rtItem As NotesRichTextItem
Dim rtnavBody As NotesRichTextNavigator
Dim rtt As NotesRichTextTable
Dim rc As Integer
Dim cc As Integer
Dim rcc As Integer
Dim cl As Integer
Dim richStyle As NotesRichTextStyle
Dim tablelayout As NotesRichTextItem
Dim db As NotesDatabase
Dim pdoc As NotesDocument
On Error Goto errorsub
Set uidoc = source
Set db =session.CurrentDatabase
Set doc = uidoc.Document
Set view = db.Getview("MailByParentID")
Set col = view.Getalldocumentsbykey(doc.DocID,True)
If col.count=0 Then Exit Sub 'No items exist so no point in carrying on.
End If
Set rtItem = New NotesRichTextItem(doc,"rtfCustMail") 'field in the current document
Set pdoc=db.Getprofiledocument("Profile Doc")
Set tablelayout = pdoc.GetFirstItem("rtfMailLog") 'Get a ready made table from the Profile Doc.
Call rtitem.AppendRTItem(tablelayout)
Set rtnavBody = rtItem.CreateNavigator
Set richStyle = session.CreateRichTextStyle
Set idoc = col.Getfirstdocument()
'Add a row to the table to hold the data for the first item in the order
Call rtnavBody.FindFirstElement(RTELEM_TYPE_TABLE)
Set rtt = rtnavBody.GetElement
Do Until idoc Is Nothing
Call rtt.AddRow()
'Write the item data into the tablecells --
rc%= rtt.RowCount 'Find the number of rows in the table
cc% =rtt.ColumnCount
rcc% =rc%*cc% 'Calculate total number of table cells
cl% =rcc%-5 'Calculate cell number of the first cell in the new (last) row
Call rtnavBody.FindNthElement(RTELEM_TYPE_TABLECELL,cl%) 'Move to the first cell in the last row
Call rtitem.BeginInsert(rtnavBody)
Call rtitem.Appenddoclink(idoc,"")
Call rtitem.EndInsert
Call rtnavBody.FindNextElement(RTELEM_TYPE_TABLECELL)
Call rtitem.BeginInsert(rtnavBody)
Call rtitem.AppendText(******need to add characters in here or better still images.)
Call rtitem.EndInsert
'To
Call rtnavBody.FindNextElement(RTELEM_TYPE_TABLECELL)
Call rtitem.BeginInsert(rtnavBody)
Call rtitem.AppendText(idoc.SendTo(0))
Call rtitem.EndInsert
etc etc.
Set idoc = col.Getnextdocument(idoc)
Loop
errorsub: Print " Line " Erl & " Reason - "& Error$
End Sub
Unicode characters can simply be appended as text. There is some complication because Notes is using LMBCS, not Unicode. Still, if you can paste the character you want into a text string in your LotusScript code, the conversions will be done behind the scenes. If there are any issues with it, I uploaded an NSF containing a full listing of all Unicode characters with their LMBCs equivalents on the OpenNTF website somewhere between 10 and 20 years ago. I still have a copy if it can no longer be found after the various changes to OpenNTF.
BTW, a very useful trick that I've found for getting content into a NotesRichText item that is being constructed on the fly from parts that you have already built advance is the AppendToRTItem method. I.e., you are building rtitem, as above. You have a config document containing a rich text field containing the content that you want (e.g., an image, a hypertext link, something with a hide-when formula, etc.) so you open that config document, get the NotesRichText item from that document into rtitem2, and call rtitem2.AppendToRTItem(rtitem).
I have an Excel VBA program that will find a Lotus Notes email with specific text in the subject and import the body into the Excel spreadsheet.
I can find the email, and import the data to Excel. Unfortunately, it seems to be creating a new line where there isn't a new line character.
I noticed that the breaks in the Excel sheet match up with the line wrapping in Word when I cut and paste the Body into a Word doc and the doc is in portrait mode.
If I change Word to landscape, it looks like the e-mail.
Changing the Excel sheet to landscape had no effect.
I also tried changing the split to use vbCR and vbLf independently of each other without positive results.
Is there a line length option I can set? How can I keep all the data associated with one line in the e-mail with one line in Excel?
Sub LNExtract()
Dim NSession As Object 'NotesSession
Dim NMailDb As Object 'NotesDatabase
Dim NDocs As Object 'NotesDocumentCollection
Dim NDoc As Object 'NotesDocument
Dim NNextDoc As Object 'NotesDocument
Dim NItem As Object 'NotesItem
Dim view As String
Dim filterText As String
view = "Folder\SubFolder" 'Name of view or folder to retrieve documents from
filterText = "SubjectLineText" 'Optional text string to filter the view
Set NSession = CreateObject("Notes.NotesSession")
Set NMailDb = NSession.GETDATABASE("", "") 'Default server and database
If Not NMailDb.IsOpen Then
NMailDb.OPENMAIL
End If
Set NDocs = NMailDb.GETVIEW(view)
NDocs.Clear
'Apply optional filter
If filterText <> "" Then
NDocs.FTSEARCH filterText, 0
End If
Set NDoc = NDocs.GETFIRSTDOCUMENT
Do Until NDoc Is Nothing
Set NNextDoc = NDocs.GETNEXTDOCUMENT(NDoc)
Set NItem = NDoc.GETFIRSTITEM("Body")
If Not NItem Is Nothing Then
Lines = Split(NItem.Text, vbCrLf)
Range("A1").Resize(UBound(Lines) + 1, 1).Value = Application.WorksheetFunction.Transpose(Lines)
End If
Set NDoc = NNextDoc
Loop
End Sub
Where you have NItem.Text in your code, I'm fairly sure that gives the same result as the GetFormattedText method of the NotesRichTextItem class, which limits the line length. Relevant documentation is here:
https://help.hcltechsw.com/dom_designer/9.0.1/appdev/H_GETFORMATTEDTEXT_METHOD.html
In contrast, the GetUnformattedText method doesn't limit the line length, so you should get a better result if you replace NItem.Text with NItem.GetUnformattedText().
I'm trying to edit an existing notes document via VBA and then send it automatically.
I've already created pretty much everything - just need to figure out how exactly I can add a certain text at a certain position within the richtext element.
Sub sendMail() 'inputIndID As String, inputRecipient As String, inputIncDescription As String)
Dim mailDB As Object
Dim mailToSend As Object
Dim body As Object
Dim session As Object
Dim view As Object
Dim entries As Object
Dim docIDs() As String
Dim docSubjects() As String
Dim incID, incDescription As String
Dim element As String
Dim bodyNavigator As Object
incID = "<INC-ID>"
incDescription = "<INC-Betreff>"
'Start a session to notes
Set session = CreateObject("Notes.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
'Call Session.Initialize
'or use below to supply password of the current ID
'Open the mail database in notes
Set mailDB = session.GetDatabase("Eschen10/Presta", "mail\qcpcsupport.nsf")
If mailDB.IsOpen = False Then
Call mailDB.Open
End If
'Search for all the messages in the folder "Umfrage"
Set view = mailDB.GetView("Umfrage")
Set entries = view.AllEntries
If entries.Count = 0 Then
MsgBox "Keine Nachricht im Umfrage Ordner."
End If
ReDim docIDs(entries.Count - 1)
ReDim docSubjects(entries.Count - 1)
Set entry = entries.GetFirstEntry
Do Until entry Is Nothing
docIDs(i) = entry.NoteID
docSubjects(i) = entry.Document.GetItemValue("Subject")(0) 'based on standard R5 mail template column order
'If the documents title matches the searched one it will be taken and worked with later
If docSubjects(i) = "Umfrage PC-Support Servicequalität" Then
Set mailToSend = entry.Document
End If
i = i + 1
Set entry = entries.GetNextEntry(entry)
Loop
'Set the recipient
Call mailToSend.ReplaceItemValue("SendTo", "simon.hartmann#thyssenkrupp.com")
'Get and change the body content
Set body = mailToSend.GetFirstItem("Body")
Set bodyNavigator = body.CreateNavigator()
'Replace markers with correct text
element = "<"
If (body.Type = RICHTEXT) Then
Call bodyNavigator.FindFirstString(element)
Call body.BeginInsert(bodyNavigator, True)
Call body.AppendText("123456")
Call bodyNavigator.FindNextString(element)
Call body.BeginInsert(bodyNavigator, True)
Call body.AppendText("Antrag Guest WLAN")
End If
'Example to save the message (optional)
mailToSend.SaveMessageOnSend = True
'Send the document
'Gets the mail to appear in the Sent items folder
mailToSend.Save True, False
Call mailToSend.ReplaceItemValue("PostedDate", Now())
Call mailToSend.Send(False)
'changes the body back and saves the document in the folder "Umfrage" so it can be resent next time
Call mailToSend.PutInFolder("Umfrage")
'Clean Up
Set mailDB = Nothing
Set mailToSend = Nothing
Set body = Nothing
Set session = Nothing
End Sub
Currently I am failing at the following line:
Call body.BeginInsert(bodyNavigator, True)
I get the error - Runtime Error 13 - Type Mismatch
I also already tried to give all variables the correct data type of Lotus Notes - but then I have the problem with each of those variables.
Is there a way I can "force" the bodynavigator to be of the correct type? Or where do I have my mistake? Am I missing a library or anything?
Thanks in advance!!!
Regards,
Simon
Did you read the documentation for NotesRichtextNavigator?
You find the following information there:
Parameters
target$
String. The search string.
options$
Long. Any of the following. Specify multiple options by combining them with addition or logical ORs.
RT_FIND_ACCENTINSENSITIVE (4) (default is accent sensitive)
RT_FIND_CASEINSENSITIVE (1) (default is case sensitive)
RT_FIND_PITCHINSENSITIVE (2) (default is pitch insensitive)
So: Your second parameter "true" is simply the wrong type... therefor the type mismatch...
My question is based on this question and this solution:
I have a similar problem, but I need to insert items in order, but I could not index the inserted repeating content controls correctly. I do not know how many items I should insert in advance, so inserting could be fully dynamic.
Could anybody help me?
Here is a simple code:
Dim wordApp As Variant
Dim wDoc As Variant
Set wordApp = CreateObject("word.application")
wordApp.DisplayAlerts = False
Set wDoc = wordApp.Documents.Open(ThisWorkbook.Path & "/example.docm")
wordApp.Visible = True
Dim i As Integer
Dim counter As Integer
counter = 1
Dim cc As Variant
Dim repCC As Variant
Set cc = wDoc.SelectContentControlsByTag("container").Item(1)
For i = 1 To 4
If counter <> 1 Then
Set repCC = cc.RepeatingSectionItems.Item(cc.RepeatingSectionItems.Count)
repCC.InsertItemAfter
End If
wDoc.SelectContentControlsByTag("number").Item(counter).Range.Text = counter
counter = counter + 1
Next i
A picture of my word doc:
The tag name of the repeating content control is "container". The tag name of the rich text content control is "number".
A picture of the wrong result:
And what I would like to get :)
Thank you for your help in advance!
Finally I could resolve my problem:
TASK: This is a simply example of inserting Repeating Section Content Controls (RSCC) dynamically from vba and fill out their inner Content Controls in order.
PROBLEM: When inserting a new RSCC like here, their Content Controls will get the same tags (titles), and indexes are assigned randomly.
SOLUTION: Content controls must be filled out on the fly, when a new RSCC has been just inserted.
Dim cc As Variant
Dim repCC As Variant
Dim i As Integer
Set cc = wDoc.SelectContentControlsByTag("container").Item(1)
For i = 1 To 4 'it could be any number
If i = 1 Then 'because already has a RSCC in the doc file, so I need only 3 more.
Set repCC = cc.RepeatingSectionItems.Item(1)
Else
repCC.InsertItemAfter
Set repCC = cc.RepeatingSectionItems.Item(i) '(or .Item(cc.RepeatingSectionItems.Count))
End If
For Each cc_current In repCC.Range.ContentControls
Select Case cc_current.Tag
Case Is = "number"
cc_current.Range.Text = i
'Case Is = .....
End Select
Next cc_current
Next i
I have some NotesDocument where some RichText fields have both text and inline images. I can get text part of that items but can't retrieve inline images using lotusscript. Could any one please suggest me a way to retrieve inline images from that documents.
LotusScript code:
Sub Click(Source As Button)
Dim session As New NotesSession
Dim db As NotesDatabase
Dim mainDoc As NotesDocument
Dim v As NotesView
Set db = session.CurrentDatabase
Dim fileName As String
Dim fileNum As Integer
fileNum% = Freefile()
fileName$ = "D:\data.txt"
Open FileName$ For Append As fileNum%
Set v = db.GetView("MyView")
Set mainDoc = v.GetFirstDocument
While Not ( mainDoc Is Nothing )
Forall i In mainDoc.Items
If i.Type = RICHTEXT Then
Write #fileNum% , i.Name & ":" & i.text 'how the images??
End If
End Forall
Set mainDoc = v.GetNextDocument( mainDoc )
Wend
End Sub
Thanks.
Midas is the easiest way to do it, but it isn't free. (It's more than worth the money in overall time saved, but if your organisation is anything like the ones I've worked for, the entire cost of the tool is going to be foisted off on the billing unit that owns the current project, rather than have it amortized over the entire org, and they're likely to change their requirements before agreeing to the cost.) There is another approach, and that's to export the database to DXL (Domino XML) using the export option ConvertNotesBitmapToGIF. The images will turn up in the XML as <picture> elements with the data Base64-encoded. If you're operating entirely within the Notes environment, you'll need to create a temporary document with a rich text field used as a NotesMIMEEntity to transform the encoded picture to binary before streaming it to a file (using NotesStream). All of this assumes that you are working with version 6 or higher; if you are on R5 or earlier, Midas or directly accessing the CD records using the C API are the only way to fly.
Seven years later, and I've been pulling my hair out over this one. Rod H's answer is for attachments, but embedded images are another thing entirely.
My best luck came from #andre-guirard's LotusScript Gold Collection code located here: https://www.openntf.org/main.nsf/project.xsp?r=project/LotusScript%20Gold%20Collection However, that doesn't get everything because it doesn't handle documents where the embedded images were embedded the old way. (Notes changed the way it stores embedded images.)
I tried very hard to combine it with AGECOM's information presented here: https://www.agecom.com.au/support/agecomkb.nsf/0/58cbf10f0ab723c9ca25803e006c7de8?OpenDocument by changing Andre's EmbeddedImage object to seamlessly handle both formats by looking to see if the embedded image within a rich text field is really just a pointer to a $FILE field and then, if so, getting a FileItem object, but eventually I exhausted my understanding and options to a degree that I couldn't justify spending my employer's resources (my time) on it.
So if you have embedded images that are all contained in the new way, I think Andre's code will work unmolested. Otherwise, I tried my best but I don't have an answer... I have what is (for me) a dead end, presented in the hopes that you or someone else who stumbles upon it can embarrass me by explaining what I was doing wrong!
Basically, I started with Andre's code and changed it in the following ways...
In DOMUtils, add the following method:
%REM
Function DU_GetMeOrNextSiblingWithAttr
Description: Starting with a particular node, return that node or the next sibling with an attribute that has a particular value.
Does not recurse into the tree; looks only at the node passed and later siblings.
Parameters:
nodeStart: node to start your search with.
targetElement: element name of desired node.
attrName: attribute name you want to check.
attrValue: attribute value of element you're looking for.
flags: string-matching flags to compare attribute, e.g. 1 for case insensitive.
%END REM
Function DU_GetMeOrNextSiblingWithAttr(nodeStart As NotesDOMNode, ByVal targetElement$, ByVal attrName$, ByVal attrValue$, ByVal flags%) As NotesDOMElementNode
Dim node As NotesDOMNode, elTmp As NotesDOMElementNode
Set node = nodeStart
Do Until node.Isnull
If node.Nodetype = DOMNODETYPE_ELEMENT_NODE Then
If node.Nodename = targetElement Then
Set elTmp = node
If StrComp(elTmp.Getattribute(attrName), attrValue, flags) = 0 Then
Set DU_GetMeOrNextSiblingWithAttr = elTmp
Exit Function
End If
End If
End If
Set node = node.Nextsibling
Loop
End Function
Replace FileItem.New with the following code:
%REM
Sub New
Description: Arguments are the parsed DOM node of the element representing a
design element, and the name of the composite item you would like to read,
modify or create.
%END REM
Sub New(parent As FileItemParent, elNote As NotesDOMElementNode, itemName$, fileName$)
Set m_elNote = elNote
SetItem elNote, itemName$, fileName$
Dim node As NotesDOMNode
Set node = m_elNote.Parentnode
While node.Nodetype <> DOMNODETYPE_DOCUMENT_NODE
Set node = node.Parentnode
Wend
Set m_domd = node
parent.RegisterFileItem Me ' make sure the design element knows about us.
' (in case someone gets smart and invokes the constructor directly
' instead of using the nice methods we've provided).
End Sub
%REM
Sub SetItem
<!-- Created Dec 6, 2017 by JSmart523 -->
If fileName$ is blank, returns the XPath equivalent of elNote/ancestor::document/item[#name=itemName$][position()=1]
If fileName$ is not blank, returns the XPath equivalent of elNote/ancestor::document/item[#name=itemName$][object/file/#name=fileName$][position()=1]
Case insensitive. Changes itemName$ and fileName$ to the correct case if found.
Also sets Me.m_elItem to the returned NotesDOMElementNode
Also sets Me.m_elRawData to the file contents
%END REM
Sub SetItem(elNote As NotesDOMElementNode, itemName$, fileName$)
Dim elFile As NotesDOMElementNode
Dim node As NotesDOMNode
'set node to ancestor::document
Set node = elNote
Do Until node.NodeName = "document"
Set node = node.ParentNode
Loop
'If fileName$ = "", get the first ancestor::document/item[#name=itemName$]
'Otherwise, get the first ancestor::document/item[#name=itemName$][/object/file/#name=fileName$]
Set m_elItem = DU_GetChildOfType(node, DOMNODETYPE_ELEMENT_NODE)
QualifyingItem m_elItem, itemName$, m_elRawData, fileName$
m_itemName = itemName$
m_fileName = fileName$
End Sub
%REM
Sub QualifyingItem
<!-- Created Dec 8, 2017 by JSmart523 -->
Starting with incoming elItem node, ensures it's an item we want or changes elItem to the first sibling that qualifies.
%END REM
Sub QualifyingItem(elItem As NotesDOMElementNode, itemName$, elRawData As NotesDOMElementNode, fileName$)
Dim elFile As NotesDOMElementNode
Dim node As NotesDOMNode
Dim elObject As NotesDOMElementNode
If Not elItem Is Nothing Then
'Initially, elItem is just a starting point, not necessarily the item we want.
'If it's an item with the right name, great, otherwise change elItem to the next sibling item with the right name.
Set elItem = DU_GetMeOrNextSiblingWithAttr(elItem, "item", "name", itemName$, 1)
If Not elItem Is Nothing Then
If fileName$ = "" Then
'we have the right item, and aren't looking for a file node, which means we want the rawitemdata node
Set elRawData = DU_getChildNamed("rawitemdata", elItem)
Else
'We are looking for a $FILE item that contains a file.
'There are possibly several $FILE items within a document, one for each file. We've got the right one if ./object/file/#name = fileName$
Do
Set elObject = DU_GetChildNamed("object", elItem)
If Not elObject Is Nothing Then
Set elFile = DU_GetChildWithAttr(elObject, "file", "name", fileName$, 1)
If Not elFile Is Nothing Then
'Yay! We have the right elItem node!
Set elRawData = DU_GetChildNamed("filedata", elFile)
fileName$ = elFile.GetAttribute("name")
Exit Do
End If
End If
Set elItem = DU_GetMeOrNextSiblingWithAttr(elItem.NextSibling, "item", "name", itemName$, 1)
Loop Until elItem Is Nothing
'At this point, either we jumped out of the loop with a valid elItem and elRawData, or elItem is Nothing
End If
End If
End If
If elItem Is Nothing Then
'we didn't find the correct item
'make sure elRawData is changed to Nothing, too.
Set elRawData = Nothing
Else
itemName$ = elItem.GetAttribute("name")
End If
End Sub
Also in FileItem script library, add a new class, FileItemParent
%REM
Class FileItemParent
<!-- Created Dec 5, 2017 by JSmart523 -->
This is a base class for objects that use FileItem objects
%END REM
Class FileItemParent
m_elElRoot As NotesDOMElementNode
m_elFD As NotesDOMElementNode
Public m_fileItem As FileItem
m_fItems List As FileItem ' list of FileItems we've created and returned to caller.
m_iMode As Integer
%REM
Property Get DOMElement
Description: Return the element node representing the design element.
%END REM
Public Property Get DOMElement As NotesDOMElementNode
Set DOMElement = m_elElRoot
End Property
%REM
Sub New
Arguments:
db: the database containing the design element.
elElement: the DOM element corresponding to the design note (e.g. the <note>
element).
domp: The DOM parser object containing elElement.
%END REM
Sub New(elElement As NotesDOMElementNode)
Set m_elElRoot = elElement
End Sub
Sub Delete
On Error Resume Next
ForAll thing In m_fItems
Delete thing
End ForAll
End Sub
%REM
Function HasItem
Description: Determine whether there's an item element in the note DXL with a
given item name.
Note that the presence of an item doesn't guarantee it's formatted as a file
CD record.
%END REM
Function HasItem(ByVal itemName$) As Boolean
HasItem = Not (DU_GetChildWithAttr(m_elElRoot, "item", "name", itemName, 1) Is Nothing)
End Function
%REM
Function RegisterFileItem
Description: For internal use -- lets the FileItem class notify us that it's
referencing our DOM tree so that we can delete the object if we erase the
corresponding item element.
%END REM
Sub RegisterFileItem(x As FileItem)
Set m_fItems(LCase(x.itemName)) = x
If m_FileItem Is Nothing Then
Set m_FileItem = x
End If
End Sub
%REM
Function GetFileItem
Description: Retrieve the FileItem object associated with a CD-record item.
An object will be returned even if the item doesn't exist, which you can
use to create the item via UpdateFile method.
%END REM
Function GetFileItem(itemName$, fileName$) As FileItem
Set GetFileItem = New FileItem(Me, m_elElRoot, itemName, fileName)
End Function
End Class
The FileItemParent class is primarily code taken from Andre's FileResource class so that both FileResource and EmbeddedImage can use it. Change FileResource to extend FileItemParent, removing any duplicated code.
Now we want to change EmbeddedImage so that, even if the embedded image node contains a link to a $FILE item rather than the actual contents, return the actual contents.
So, change EmbeddedImage to extend FileItemParent
Add/replace the following methods to EmbededImage
%REM
Sub InitFileItem
<!-- Created Dec 6, 2017 by JSmart523 -->
Called by New
%END REM
Sub InitFileItem()
Dim buffer As Variant 'byte array
Dim iFileNameLen As Integer
Dim sFileName As String
Dim sItemName As String
Dim stream As NotesStream
If Len(m_b64) < 30000 Then
'If content is short then maybe it's a link to a $FILE item instead of the actual content?
Dim session As New NotesSession
Set stream = session.CreateStream()
Base64ToBinary m_b64, stream
stream.Position = 0
buffer = stream.Read(1)
If buffer(0) = 196 Then
'this is a link to a $FILE, not the actual image contents!
stream.Position = 10
buffer = stream.Read(2)
iFileNameLen = ConvertWordByteArray(buffer)
stream.Position = 24
buffer = stream.Read(iFileNameLen)
sFileName = BytesToString(buffer)
sItemName = "$FILE"
GetFileItem sItemName, sFileName 'sets m_fileItem to a FileItem object
End If
End If
End Sub
%REM
Property Get SuggestedFileName
%END REM
Public Property Get SuggestedFileName As String
If m_fileItem Is Nothing Then
SuggestedFileName = "Embedded-" + ItemName + "." + SuggestedFileType
Else
SuggestedFileName = m_fileItem.FileName
If InStr(SuggestedFileName, ".") = 0 Then
SuggestedFileName = SuggestedFileName + "." + SuggestedFileType
End If
End If
End Property
%REM
Property Get SuggestedFileType
%END REM
Public Property Get SuggestedFileType As String
If ImageType = "notesbitmap" Then
SuggestedFileType = "bmp"
Else
SuggestedFileType = ImageType
End If
End Property
%REM
Sub ReadFileToStream
%END REM
Sub ReadFileToStream(streamOut As NotesStream)
If m_FileItem Is Nothing Then
ReadToStream streamOut
Else
Set m_FileItem.Stream = streamOut
m_FileItem.Load
End If
End Sub
and then change EmbeddedItem.New to, at the end, call InitFileItem so that if it's a link then getting the contents returns the contents rather than the link.
Okay, so far so good as far as I know, but the problem is that CD Records of embedded images stored within $FILE items (i.e. the rich text field's embedded image node simply contains a link rather than the actual image) are/were documented in a way that was, for me, impenetrable, despite AGECOM's code and explanations. I could use the above code and Andre's EmbeddedImageList object to grab every single embedded image but I simply couldn't get a "ConvertOldCDToNew" method working so I couldn't convert the old CD Record format into solid, uncorrupted files! I don't know if I was stripping too many bytes, not stripping the right ones, or maybe I just forgot to carry the two!
I suggest you look at the Genii Software MidasLSX product. They offer a package of LotusScript extensions that make it easier to deal with the complexities of Lotus Notes Rich Text items.
http://www.geniisoft.com/showcase.nsf/MidasHelp
Otherwise, you can experiment with the NotesRichTextNavigator class to gain access to the image in the rich text item (in theory). There is very little documentation on this sort of thing. I couldn't quite tell what an image would appear as using that class, but assuming you navigate through the rich text item and are able to get a handle the image as a NotesEmbeddedObject, I know there's a way to save the object to disk from that class.
Another (crazy) thought is to email the document, and have it received by another program that can more easily process the body of the email. Notes just isn't very helpful with processing its own rich text fields.
Here is an agent I use to detach files from a richtext field on my documents.
Option Public
Dim uidoc As notesuidocument
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim obj As NotesEmbeddedObject
Dim collection As NotesDocumentCollection
Dim rt As Variant
Dim attachNames As Variant
Dim i As Integer, x As Integer
Dim j As Integer
' Agent - Detach Attachments to C drive for later reattachment
' Copies all attachment in richtext field to personal directory.
Sub Initialize
Dim ws As New notesuiworkspace
Dim ses As New NotesSession
Set db = ses.CurrentDatabase
Set collection = db.UnprocessedDocuments
' get first doc in collection
For j = 1 To collection.Count
Set doc = collection.GetNthDocument( j )
' --- create array of filenames of all the attachments in the document
i = 0
Redim attachNames(i)
Forall x In doc.items
If x.name = "$FILE" Then
attachNames(i) = x.values(0)
i = i + 1
Redim Preserve attachNames(i)
End If
End Forall
If i > 0 Then
Redim Preserve attachNames(i-1)
End If
' --- for all of the filenames in attachNames, if it exists in the rich text field, detatch them
If doc.hasItem("richtextfieldname") Then
Set rt = doc.GetFirstItem("richtextfieldname")
End If
If attachNames(0) <> "" Then
Forall x In attachNames
Set obj = rt.GetEmbeddedObject( x )
If Not( obj Is Nothing ) Then
Call obj.ExtractFile( "C:\path\" & Cstr(x) )
End If
End Forall
End If
Call doc.save(True, False)
Next
End Sub