'[LotusScript]
' @param doc - Document to be converted to MIME.
' @param itemName - The name of the item to be converted in the document to be converted.
' @param (return) outSt - The stream where MHTML is output.
Sub ConvertToMime(doc As NotesDocument, itemName As String, outSt As NotesStream)
Dim session As New NotesSession
Dim convertMimeFlg As Boolean
' ** Remember the state
convertMimeFlg = session.Convertmime
' ---
' ** original document
' Get items from the original document.
Dim orgItem As NotesItem
Set orgItem = doc.Getfirstitem(itemName)
If orgItem Is Nothing Then
' [Error]
GoTo ExitTag
End If
' ---
' ** temporary document
Dim curDB As NotesDatabase
Set curDB = session.Currentdatabase
' ** create temporary document.
Dim tmpDoc As NotesDocument
Set tmpDoc = curDB.Createdocument()
If orgItem.Type= 1 Then
' ** Within this database,
' ** you need a form design that has a rich text field with the field name "Body".
tmpDoc.Form = "ConvertRichTextToMIME"
' ** In the "NotesDocument.ConvertToMime" specification,
' ** the output field name is fixed to "Body".
Dim tmpRtItem As NotesRichTextItem
Set tmpRtItem = New NotesRichTextItem(tmpDoc, "Body")
Call tmpRtItem.Appendrtitem(orgItem)
Else
' ** Within this database,
' ** you need a form design that has a text field with the field name "Body".
tmpDoc.Form = "ConvertTextToMime"
' ** In the "NotesDocument.ConvertToMime" specification,
' ** the output field name is fixed to "Body".
Call tmpDoc.Copyitem(orgItem, "Body")
End If
' --
' ** Turn off MIME conversion
session.Convertmime = False
' ---
' ** Convert temporary documents to MIME.
' ** throw error 4785
' ** When the RichText size is bigger, etc.
' ** @see https://www.hcljapan.co.jp/software/help/DominoDesigner/topic/com.ibm.designer.domino.main.doc/H_CONVERTTOMIME_METHOD.html
Call tmpDoc.Converttomime(CONVERT_RT_TO_HTML)
' --
' ** export mime entity
Dim mime As NotesMIMEEntity
Set mime = tmpDoc.Getmimeentity("Body")
If mime Is Nothing Then
' [Error] MIME conversion failed.
GoTo ExitTag
End If
Dim result As Integer
result = ExportMimeEntity(mime, outSt)
If result <> 0 Then
' [Error] MIME conversion failed.
GoTo ExitTag
End If
ExitTag:
' ** Revert the state
session.Convertmime = convertMimeFlg
Exit Sub
End Sub
' @param mime - mime entity of temporary document.
' @param outSt - output stream. format as MHTML.
' @see https://ja.wikipedia.org/wiki/MHTML
Function ExportMimeEntity(mime As NotesMIMEEntity, outST As NotesStream) As Integer
On Error GoTo ErrorHandle
Dim session As NotesSession
Dim buffer As NotesStream
Dim result As Integer
Dim child As NotesMIMEEntity
If mime.Contenttype = "multipart" Then
Dim CRLF As String
CRLF = Chr(13) & Chr(10)
Dim boundary As String
boundary = GetBoundary(mime.Headers)
Call outSt.Writetext(mime.Headers & CRLF & CRLF)
Call outSt.Writetext(boundary & CRLF)
Call outSt.Writetext(mime.ContentAsText)
Call outSt.Writetext(CRLF)
Set session = New NotesSession
Set buffer = session.CreateStream()
Set child = mime.Getfirstchildentity()
Do Until mime Is Nothing
Call buffer.Truncate()
result = ExportMimeEntity(child, buffer)
If result <> 0 Then
Error result
End If
Call outSt.Writetext(boundary & CRLF)
buffer.Position = 0
Call outSt.Writetext(buffer.Readtext)
Call outSt.Writetext(CRLF)
Set child = child.Getnextsibling()
Loop
ElseIf mime.Contenttype = "text" Then
Set session = New NotesSession
Set buffer = session.Createstream()
' ** decoded LMBCS -> OSString
Call mime.Getcontentastext(buffer, True)
buffer.Position = 0
Call outST.Writetext(buffer.Readtext)
Call buffer.Truncate()
Call buffer.Close()
Else
' *** any binary
Call outST.Writetext(mime.ContentAsText)
End If
Exit Function
ErrorHandle:
ExportMimeEntity = Err
Exit Function
End Function
Function GetBoundary (header As String) As String
'** get the boundary from the initial header of a multi-part MIME string
'** normally, the format in Notes is something like:
'** Content-Type: multipart/related; boundary="=_related 0012868C85256E16_="
Dim boundary As String
boundary = StrRight(header, "boundary=""")
'** we want everything from the boundary=" to the closing "
If (InStr(boundary, """") > 0) Then
boundary = StrLeft(boundary, """")
End If
If (Len(boundary) > 0) Then
boundary = "--" & boundary
End If
GetBoundary = boundary
End Function
