I am extracting attachments in a document to user's local machine using LotusScript. The document has two rich text fields Body1 and Body2 and many a times only one of them has an attachment in it. I am using the below code snippet:
Dim doc As NotesDocument
Dim richTextItem As NotesRichTextItem
.....
.....
If doc.Hasembedded Then
Set richTextItem = doc.Getfirstitem("Body1")
ForAll o In richTextItem.Embeddedobjects
Call o.ExtractFile(dirName + "\" + o.Name)
End ForAll
Set richTextItem = doc.Getfirstitem("Body2")
ForAll o In richTextItem.Embeddedobjects
Call o.ExtractFile(dirName + "\" + o.Name)
End ForAll
End If
The problem is that if Body1 does not have attachment in it and Body2 does then the above code throws error of Type mismatch on statement ForAll o In richTextItem.Embeddedobjects and vice versa as there are no embedded objects in that rich text item. Also doc.Embeddedobjects does not work because attachments are present inside rich text items. And the NotesRichTextItem class does not have Hasembedded property which can be used to check presence of attachments in it.
What would be a way out of this?
Try this instead:
Dim doc As NotesDocument
.....
.....
If doc.Hasembedded Then
Set richTextItem = doc.Getfirstitem("Body1")
Set rtnav = richTextItem.CreateNavigator
If rtnav.FindFirstElement(RTELEM_TYPE_FILEATTACHMENT) Then
Do
Set att = rtnav.GetElement()
filepath$ = dirName + "\" + att.Source
Call att.ExtractFile(filepath$)
Loop While rtnav.FindNextElement()
End If
Set richTextItem = doc.Getfirstitem("Body2")
Set rtnav = richTextItem.CreateNavigator
If rtnav.FindFirstElement(RTELEM_TYPE_FILEATTACHMENT) Then
Do
Set att = rtnav.GetElement()
filepath$ = dirName + "\" + att.Source
Call att.ExtractFile(filepath$)
Loop While rtnav.FindNextElement()
End If
End If
You may also want to extract the redundant logic into a subroutine.
This is a short code if you want extract all attachments of a document no matter where they are stored:
Dim vAttachmentList As Variant
vAttachmentList = Evaluate("#AttachmentNames", doc)
If vAttachmentList(0) <> "" then
ForAll sAttachmentName In vAttachmentList
Call doc.Getattachment(sAttachmentName).ExtractFile(dirName + "\" + sAttachmentName)
End ForAll
End if
Updated answer
Instead of accessing the EmbeddedObjects property directly in the forall, assign it to a variant and check it first, using the TypeName function to make sure that the returned value was really an array of NotesEmbeddedObject objects, like this:
dim objectArray as variant
If doc.Hasembedded Then
Set richTextItem = doc.Getfirstitem("Body1")
Set objectArray = richTextItem.Embeddedobjects
If TypeName(objectArray) = "NOTESEMBEDDEDOBJECT( )" Then
ForAll o In objectArray
Call o.ExtractFile(dirName + "\" + o.Name)
End ForAll
End If
End If
Related
In my agent, I try to retrieve all the files that are in the current email. My attached code works fine, except for the images in the body of the email. I manage to retrieve all the files and images that were attached to the email except the pictures that were copied and pasted in the middle of the email text. Here is my code:
Dim session As New NotesSession
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim item As Variant
Dim CurrentDocColl As NotesDocumentCollection
Set db = Session.Currentdatabase
Set CurrentDocColl = db.Unprocesseddocuments
Set doc = CurrentDocColl.Getfirstdocument
While Not doc Is Nothing
Set item = doc.GETFIRSTITEM("Body")
If doc.HasEmbedded Then
ForAll attachment In item.EmbeddedObjects
Call attachment.ExtractFile (pathname & "\" & attachment.Name)
End ForAll
End If
Set doc=CurrentDocColl.Getnextdocument(doc)
Wend
How can I retrieve these images?
Thank you very much for your help
I have an agent that does a lot of that, but it's not short. What you have to do is run the document through an XML DomParser, walk down the DOM tree and when you find a node with "JPEG" or "PNG" in the name (the inline images themselves), stream the data to a file and save it. The code is combination of an agent I found online (which I couldn't find again, otherwise I would give credit) and work I've done. You won't be able to copy/paste this sample code and expect it to work, I've removed things (like declaring variables and supporting functions) for brevity.
Sub Initialize
Dim dxlExp As NotesDXLExporter
Set dxlExp = s.CreateDXLExporter
Call dxlExp.setInput(Doc)
Set DomParser=s.CreateDOMparser()
Call DomParser.Setinput(dxlExp)
Dim dxlImp As NotesDXLImporter
Set dxlImp = s.Createdxlimporter()
Call dxlImp.Setinput(domParser)
Call dxlImp.SetOutput(db)
On Event PostDomParse From DomParser Call DomInputProcessed
Call dxlExp.Process
End Sub
Sub DomInputProcessed(DomParser As NotesDomParser)
Dim DomNode As NotesDomNode
Set DomNode = DomParser.Document
Call walkTree(DomParser, DomNode)
Exit Sub
End Sub
Sub walkTree (DomParser As NotesDOMParser, node As NotesDOMNode)
Select Case node.NodeType
Case DOMNODETYPE_DOCUMENT_NODE: ' If it is a Document node
domParser.Output( "<?xml version='1.0' encoding='utf-8'?>"+LF )
Set child = node.FirstChild ' Get the first node
Dim numChildNodes As Integer
numChildNodes = node.NumberOfChildNodes
While numChildNodes > 0
Set child = child.NextSibling ' Get next node
numChildNodes = numChildNodes - 1
Call walkTree(DOMParser, child)
Wend
Case DOMNODETYPE_DOCUMENTTYPE_NODE: ' It is a <!DOCTYPE> tag
domParser.Output("<!DOCTYPE "+ node.NodeName+ ">" + LF)
Case DOMNODETYPE_TEXT_NODE: ' Plain text node
value = xmlReplace(node.NodeValue)
domParser.Output(value)
Case DOMNODETYPE_ELEMENT_NODE: ' Most nodes are Elements
Select Case node.NodeName
Case "jpeg"
Dim jpegfile As String
' Step 1, write the MIME file
Dim base64node As NotesDOMNode
Set base64Node = node.Firstchild
Dim base64Out As NotesStream
Set base64Out = s.createStream()
Dim bytesWritten As Long
bytesWritten = base64Out.Writetext(base64Node.NodeValue)
' Step 2, Read the MIME file and decode it.
Set db=s.currentdatabase
Set doc=db.createDocument()
Set m=doc.Createmimeentity("Image1")
Call m.setContentFromText(base64Out, "image/jpeg", 1727)
Call m.Decodecontent()
Dim JPEGOut As NotesStream
Set JPEGOut = s.createStream()
jpegFile = RandomFileName(baseDir, ".jpg")
JPEGOut.open(jpegFile)
Call m.Getcontentasbytes(JPEGOut, True)
Call JPEGOut.Close()
attachmentNamesStr = attachmentNamesStr + jpegFile + "~"
' Step 3, remove the jpeg and its child node
' We do this by just not sending anything to the DomParser output.
Case "png"
' Same as JPEG except it's PNG.
End Select
End Select 'node.NodeType
End If 'Not node.IsNull
End Sub
I had never run into this problem, but I cannot get a handle on a file attachment on an email. I have code that can either search the document for Embedded Objects or search a field for Embedded Objects -- neither of them are returning the file. I can see the file on the email and I can see the $FILE field which contains the file attachment.
Here is the code:
Function FileDetachFiles(doc As NotesDocument, fieldName As String, getFromField As Integer) As Variant
On Error Goto ProcessError
Dim s As NotesSession
Dim db As NotesDatabase
Dim rtItem As NotesRichTextItem
Dim fileToExtract As String
Dim fileName As String
Dim fileArray() As String
Dim message As String
Dim embedObjects As Variant
Dim attachFile As Integer
Dim x As Integer
Set s = New NotesSession
Set db = s.CurrentDatabase
Const fileImport = "C:\"
attachFile = False
'Let's see if there are attached files...
If getFromField = True Then
'Locate field and get files...
If doc.HasEmbedded Then
If doc.HasItem(fieldName) Then
'Set the first field...
Set rtItem = doc.GetFirstItem(fieldName)
embedObjects = rtItem.EmbeddedObjects
If Isarray(embedObjects) Then
Forall Files In rtItem.EmbeddedObjects
If Files.Type = EMBED_ATTACHMENT Then
fileName = Files.Source
fileToExtract = fileImport & fileName
Redim Preserve fileArray(x)
fileArray(x) = fileToExtract
x = x + 1
Call Files.ExtractFile(fileToExtract)
attachFile = True
End If
End Forall
End If
End If
End If
Else
x = 0
'Go through doc looking for all embedded objects...
If doc.HasEmbedded Then
Forall o In doc.EmbeddedObjects
If o.Type = EMBED_ATTACHMENT Then
fileName = o.Name
fileToExtract = fileImport & fileName
Call o.ExtractFile(fileToExtract)
Redim Preserve fileArray(x)
fileArray(x) = fileToExtract
x = x + 1
attachFile = True
End If
End Forall
End If
End If
If attachFile = True Then
FileDetachFiles = fileArray
End If
Exit Function
ProcessError:
message = "Error (" & Cstr(Err) & "): " & Error$ & " on line " & Cstr(Erl) & " in GlobalUtilities: " & Lsi_info(2) & "."
Messagebox message, 16, "Error In Processing..."
Exit Function
End Function
I tried both routines above -- passing the $FILE and Body field names, as well as searching the document. It does not find any file attachments.
I even tried this:
Extracting attachments as MIME using LotusScript
Which did not find any MIME on the document.
I have never run into this problems -- any ideas would be great.
Thanks!
I had that before, but unfortunately do not remember, where it comes from, it might have to do something with V2- Style Attachments coming from Domino Websites...
Try Evaluate( #AttachmentNames ) to get a Variant containing the names of all attachments. Then loop through this with a Forall- loop and try the NotesDocument.getAttachment( strLoopValue ) - Function to get a handle to the attachment.
For further info read here and follow the links on that page, especially this one
Code would be something like this:
Dim doc as NotesDocument
Dim varAttachmentNamens as Variant
Dim object as NotesEmbeddedObject
REM "Get the document here"
varAttachmentNames = Evaluate( "#AttachmentNames" , doc )
Forall strAttachmentName in varAttachmentNames
Set object = doc.GetAttachment( strAttachmentName )
REM "Do whatever you want..."
End Forall
The Domino server API getEmbeddedObjects(); returns the wrong result (zero) when a mail containing an attachment (as embedded object) is sent from the script.
Though an attachment is sent as an EmbeddedOBject, getEmbeddedObjects(); returns ZERO.
The mail type is NOT MIME.
This is a Java application. Is there is any workaround for this problem?
I take the body from the document. If the body is of richtextitem, I call the getEmbeddedObjects() which returns zero though an attachment is present as embedded object.
Looking through all of the items in a document for the possibility of an attachment is doing a lot of work for nothing. All you need to do is get the collection of attachment names using the #AttachmentNames formula (available through the evaluate() method of the Session object, using the Document argument), and if the collection contains more than an empty string, use the getAttachment() method of the document to get a handle to the corresponding EmbeddedObject.
getAttachment() can grab any attachment to a document, whether it's associated with a RichTextItem or a V2-style attachment (as would be created by a web UI or when converting external mail). And never be afraid to use Formula Language when it's appropriate -- it can make your life a whole lot simpler.
Attachments do not necessarily have to be embedded inside a RichText field. To quote from the designer-help:
If you need access to OLE/2 embedded objects that exist in a document but are not part of a rich text item (for example, because the object was originally created on the document's form), use the EmbeddedObjects property in Document.
Another source of your problem could be, that there are several "Body" RichText items you would have to check.
HTH
Lotus Notes does not provide a single reliable method for extracting attachments from a NotesDocument object, unfortunately. To be thorough, you'll need to check through all richtext items it contains, as well as the document object itself.
I wrote the following code to extract attachments from selected emails in a mailbox, in an effort to cut down the file size (my users saved everything). The main loop is relevant to your question, though. It shows the process of looping through all of the document's items looking for richtext items with attachments, followed by a loop through all items again looking for items of type "Attachment".
(forgive the hackiness of the code. It wasn't written for efficiency)
Sub Initialize
Set s = New NotesSession
Set db = s.CurrentDatabase
Set dc = db.UnprocessedDocuments
Set doc = dc.GetFirstDocument
Dim rtItem As NotesRichTextItem
Dim RichTextItemNames List As String
Dim DocumentItemNames List As String
Dim itemCount as Integer
While Not (doc Is Nothing)
'Scan all richtext items in document for embedded objects
Forall i In doc.Items
If i.Type = RICHTEXT Then
Set rtItem = doc.GetFirstItem(i.Name)
If Not Isempty(rtItem.EmbeddedObjects) Then
RichTextItemNames(itemCount) = Cstr(i.Name)
itemCount = itemCount + 1
End If
End If
End Forall
'Loop through richtext items and extract the embedded attachments
For j = 0 To itemCount - 1
Set rtItem = doc.GetfirstItem(RichTextItemNames(j))
Forall Obj In rtItem.EmbeddedObjects
If ( Obj.Type = EMBED_ATTACHMENT ) Then
Call ExportAttachment(Obj)
Call Obj.Remove
Call doc.Save( False, True ) 'creates conflict doc if conflict exists
End If
End Forall
Next
'Scan all items in document for Attachment type items
itemCount = 0
Forall i In doc.Items
If i.Type = ATTACHMENT Then
DocumentItemNames(itemCount) = i.Values(0)
itemCount = itemCount + 1
End If
End Forall
'Loop through all attachment items in document and extract them
For j = 0 To itemCount - 1
Set attachmentObject = doc.GetAttachment(DocumentItemNames(j))
Call ExportAttachment(attachmentObject)
Call attachmentObject.Remove
Call doc.Save( False, True ) 'creates conflict doc if conflict exists
Next
Set doc = dc.GetNextDocument(doc)
Wend
End Sub
Sub ExportAttachment(o As Variant)
Dim sAttachmentName As String
Dim sNum As String
Dim sTemp As String
' Append number to end of filename if filename exists.
sAttachmentName = sDir & "\" & o.Source
While Not (Dir$(sAttachmentName, 0) = "")
sNum = Right(Strleftback(sAttachmentName, "."), 2)
If Isnumeric(sNum) Then
sTemp = Strleftback(sAttachmentName, ".")
sTemp = Left(sTemp, Len(sTemp) - 2)
sAttachmentName = sTemp & Format$(Cint(sNum) + 1, "##00") & _
"." & Strrightback(sAttachmentName, ".")
Else
sAttachmentName = Strleftback(sAttachmentName, ".") & _
"01." & Strrightback(sAttachmentName, ".")
End If
Wend
Print "Exporting " & sAttachmentName
'Save the file
Call o.ExtractFile( sAttachmentName )
End Sub
If you get the embedded objects from the Document object, they won't contain attachments. Using getEmbeddedObjects with the "Body" RichTextItem gets the attachments too.
Does that help?
I have an agent someone shared years ago which takes attached files, saves them to my hard drive, and removes them from the email. I use it to keep my emails for a while but stay under my corporate mailbox quota. I get a LOT of attachments.
I'm now finding that a lot of the remaining large emails have embedded images rather than "attached files". Can anyone share a script that would actually be able to do the same (save to hard drive, remove from email) with an embedded image?
FWIW, here is the agent I use for detaching attachments. Props to original author, don't know who that was.
Dim sDir As String
Dim s As NotesSession
Dim w As NotesUIWorkspace
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Sub Initialize
Set s = New NotesSession
Set w = New NotesUIWorkspace
Set db = s.CurrentDatabase
Set dc = db.UnprocessedDocuments
Set doc = dc.GetFirstDocument
Dim rtItem As NotesRichTextItem
Dim RTNames List As String
Dim DOCNames List As String
Dim itemCount As Integer
Dim sDefaultFolder As String
Dim vtDir As Variant
Dim iCount As Integer
Dim j As Integer
Dim lngExportedCount As Long
Dim attachmentObject As Variant
Dim text As String
Dim subjectLine As String
Dim attachmentMoved As Boolean
' Prompt the user to ensure they wish to continue extracting the attachments
Dim x As Integer
x = Msgbox("V4 This action will extract all attachments from the " & Cstr (dc.Count) & " document(s) you have selected, and place them into the folder of your choice." & _
Chr(10) & Chr(10) & "Would you like to continue?", 32 + 4, "Export Attachments")
If x <> 6 Then Exit Sub
' Set the folder where the attachments will be exported
sDefaultFolder = s.GetEnvironmentString("LPP_ExportAttachments_DefaultFolder")
If sDefaultFolder = "" Then sDefaultFolder = "F:"
vtDir = w.SaveFileDialog( False, "Export attachments to which folder?", "All files|*.*", sDefaultFolder, "Choose Folder and Click Save")
If Isempty(vtDir) Then Exit Sub
sDir = Strleftback(vtDir(0), "\")
Call s.SetEnvironmentVar("LPP_ExportAttachments_DefaultFolder", sDir)
' Loop through all the selected documents
While Not (doc Is Nothing)
iCount = 0
itemCount = 0
lngExportedCount = 0
Erase RTNames
Erase DocNames
' Find all of the RichText fields in the current document. If any have an embedded object, add the item to the RTNames array.
Forall i In doc.Items
If i.Type = RICHTEXT Then
If Not Isempty(i.EmbeddedObjects) Then
'Msgbox i.Name,64,"Has embedded objects"
End If
Set rtItem = doc.GetfirstItem(i.Name)
'Set rtItem = i
If Not Isempty(rtItem.EmbeddedObjects) Then
RTNames(itemCount) = Cstr(i.Name)
itemCount = itemCount +1
End If
End If
End Forall
' Loop through the RTNames array and see if any of the embedded objects are attachments
attachmentMoved = False
For j = 0 To itemCount-1
Set rtItem = Nothing
Set rtItem = doc.GetfirstItem(RTNames(j))
Forall Obj In rtItem.EmbeddedObjects
If ( Obj.Type = EMBED_ATTACHMENT ) Then
' The embedded object is an attachment. Export it to the chosen directory
Call ExportAttachment(Obj)
' Append to the bottom of the file details on the extracted file and its new location.
Call rtItem.AddNewline(1)
Call rtitem.AppendText("---------------------------------------" + Chr(13) + Chr(10))
text = """" + sDir + "\"+ Obj.Name + """" + Chr(13) + Chr(10) + Chr(9) + "Extracted by: " + s.UserName + " on " + Str$(Today()) + ". "
Call rtitem.AppendText(text )
Call rtItem.AddNewline(1)
' Remove the object from the file and save the document.
Call Obj.Remove
Call doc.Save( False, True ) 'creates conflict doc if conflict exists
attachmentMoved = True
Else
Forall verb In Obj.Verbs
'Msgbox verb, 64, "VERB"
End Forall
End If
End Forall
' If the document had an attachment moved, update the subject line
If attachmentMoved = True Then
Dim item As Notesitem
Set item = doc.GetFirstItem("Subject")
subjectLine = item.Text + "- ATTACHMENT MOVED"
Set item = doc.ReplaceItemValue("Subject", subjectLine)
Call doc.Save( False, True ) 'creates conflict doc if conflict exists
End If
Next
Set doc = dc.GetNextDocument(doc)
Wend
Msgbox "Export Complete.", 64, "Finished"
End Sub
Sub ExportAttachment(o As Variant)
Dim sAttachmentName As String
Dim sNum As String
Dim sTemp As String
' Create the destination filename
sAttachmentName = sDir & "\" & o.Source
' Loop through until the filename is unique
While Not (Dir$(sAttachmentName, 0) = "")
' Get the last three characters of the filename - "_XX"
sNum = Right(Strleftback(sAttachmentName, "."), 3)
' Ensure the first of the three characters is an underscore and the next two are numeric. If they are, add one to the existing number and insert it back in.
If Left(sNum,1) = "_" And Isnumeric(Right(sNum, 2)) Then
sTemp = Strleftback(sAttachmentName, ".")
sTemp = Left(sTemp, Len(sTemp) - 2)
sAttachmentName = sTemp & Format$(Cint(Right(sNum,2)) + 1, "##00") & "." & Strrightback(sAttachmentName, ".")
Else
sAttachmentName = Strleftback(sAttachmentName, ".") & "_01." & Strrightback(sAttachmentName, ".")
End If
Wend
' Save the file
Call o.ExtractFile( sAttachmentName )
End Sub
This is very problematic to do with the script as it currently stands as MIME encoded images won't show up as any type of attachment using the EmbeddedObjects Property.
If the images are stored inline as part of a MIME message, the Notes client will turn them into an attachment for viewing, but programmatically the can only be accessed as parts of the MIME message. It should be achievable to grab the correct part of a multi-part MIME message with the image encoded (using the MIMEEntity classes), stream this out to disc and reconstitute the original file(s) then remove the MIMEEntity that represented it (and took up the space).
More info on the
IBM Support Site
NotesMIMEEntity Class Documentation
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