Notes RTF域添加图片

  　　CS结构，最开始的需求是用户在填完报销单的时候需要把单子打印出来附上Hard copy交到财务，由于财务每天要处理很多单子和Hard copy，如果手工输入报销单号码会非常不便，也很耗时间，他们希望能加上一个二维码，拿到Hard copy后用扫描枪一扫就可以了。虽然后来这个系统转交给了另一位同事，但是我一直在思考这个问题怎么解决，曾经试过嵌入ActiveX控件或Applet等的方法，但都不是太完美。我同事的解决方案是使用专用的条形码字体，但是需要在每台客户端安装这种字体。最近我终于找到了我的解决方法，支持各种条码。

 

　　注：这个实例只是添加图片部分，二维码部分可以使用Google zxing包，Notes实例可见我的另一篇博文。代码需要微调一下，由于我是做测试用的，UI部分是我自己的解决方案，Function EmbedPictureIntoRichText(doc As NotesDocument, strFilePath As String) As Boolean出自 http://www.grange.com.br/blog/40-lotus/499-lotusscript-code-to-embed-a-picture-into-a-notes-richtext-item

 

 

'我要的效果是在当前打开的文档中插入一张图片，并打印。不需要用户自己去选择图片，也不能让用户去修改RTF字段
Sub Click(Source As Button)

    Dim ws As New NotesUIWorkspace
    Dim uidoc As NotesUIDocument, readuidoc As NotesUIDocument
    Dim doc As Notesocument
    Dim session As New NotesSession

    Set uidoc = ws.CurrentDocument
    '这种方法也可以，但是RTF域必须是编辑状态
    'uidoc.GotoField("aa")
    'Call uidoc.Import("JPEG Image", "C:\\aa.jpg")
    'uidoc.EditMode = False

    ’我的方法
    Set doc = uidoc.Document
    '先保存当前文档
    uidoc.Save
    '置为阅读模式
    uidoc.EditMode=False
    '在后台文档中添加RTF的图片
    Call EmbedPictureIntoRichText(doc, "C:\aa.jpg")
    ’在CS下以阅读模式打开新的UI文档实例
    Set readuidoc = ws.EditDocument(False, doc,True,"", True,True )
    '关闭原来的UI文档
    uidoc.Close
    '打印
    readuidoc.Print
End Sub
Function EmbedPictureIntoRichText(doc As NotesDocument, strFilePath As String) As Boolean
    On Error Goto errorHandle
    EmbedPictureIntoRichText = False

    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim body As NotesMIMEEntity
    Dim header As NotesMIMEHeader
    Dim child As NotesMIMEEntity
    Dim stream As NotesStream
    Dim fileFormat As String
    Dim rtitemA As NotesRichTextItem
    Dim rtitemB As NotesRichTextItem

    Set db = doc.Parentdatabase
    Set stream = session.CreateStream
    Call stream.Open(strFilePath)
    Set rtitemB = doc.GetFirstItem("DummyRichText")
    If Not rtitemB Is Nothing Then
    Call rtitemB.Remove()
    End If
    Set body = doc.CreateMIMEEntity("DummyRichText")
    Set header = body.CreateHeader("Content-Type")
    Call header.SetHeaderVal("multipart/mixed")
    Set child = body.CreateChildEntity() 'Set childEntity = richTextItemObj.CreateChildEntity()
    fileFormat = "image/jpeg" 'Other formats are "image/gif" "image/bmp"
    Call child.Setcontentfrombytes(stream, fileFormat, 1730)
    Call stream.Close()
    Call doc.save(False, False) 'JUST TO REFRESH

    Set rtitemA = doc.GetFirstItem("aa")
    Set rtitemB = doc.GetFirstItem("DummyRichText")
    Call rtitemA.AppendRTItem( rtitemB )
    Call rtitemB.Remove()
    Call doc.save(False, False)

    EmbedPictureIntoRichText = True
    Exit Function
    errorHandle:
    Msgbox Cstr(Erl) & ": " & Error
End Function