我对Lotus不熟,最近做一个lotus数据迁移的项目
使用com组件来读取lotus中的信息,读取附件那些都没有问题,但是最近在读取RTF域的时候,发现不知道怎么把正文中的图片读取出来。RichTextItem对象返回的只有文本信息。
还望高手们不吝赐教!
------解决方案--------------------
如果是CS的话,可以用如下方法,尝试一下。
- VBScript code
首先写一个函数,如下:Function ExportPictures(doc As NotesDocument, path As String) As Variant ' ================================================================== ' Exports GIF and JPG images from a notes document into given destinationPath ' Picture's filename is path\<docid>_<number>.<extension> ' Tempfile used is path\Base64.tmp which is deleted after export ' Returns a list of strings containing filenames of exported pictures (if any) ' Base64 conversion is performed with Notes internal MIME functions, therefore ' a tempdoc is created but not saved ' ================================================================== ' by Guido Purper August 2005 ' ================================================================== Dim session As New NotesSession Dim thisDB As NotesDatabase Dim doc2 As NotesDocument Dim filename As String Dim f As Integer Dim counter As Integer Dim destinationPath As String Dim stream As NotesStream Dim mimeEntity As NotesMIMEEntity Dim mimeHeader As NotesMimeHeader Dim fileList List As String Dim k(1 To 3, 1 To 3) As String Dim i As Integer Dim exporter As NotesDXLExporter Dim dxl As String Dim dxlPicture As String Dim dxlPictureType As String Dim key As String Dim p1 As Long Dim p2 As Long On Error Goto err1 Set thisDB = session.CurrentDatabase Set exporter = session.CreateDXLExporter exporter.ConvertNotesBitmapsToGIF = True ' ================================ ' Initialize some variables ' ================================ ExportPictures="" Erase FileList ' === Key for imported GIFs === K(1,1)="<gif>" ' key tag in dxl stream K(1,2)="</gif>" ' closing tag in dxl stream K(1,3)="gif" ' file extension ' === Key for any picture converted into gif === K(2,1)="<gif originalformat='notesbitmap'>" ' key tag in dxl stream K(2,2)="</gif>" ' closing tag in dxl stream K(2,3)="gif" ' file extension ' === Key for JPEGs === K(3,1)="<jpeg>" ' key tag in dxl stream K(3,2)="</jpeg>" ' closing tag in dxl stream K(3,3)="jpg" ' file extension ' ================================ ' Make sure destination path ends with a \ ' ================================ If Right$(path,1)="\" Then destinationPath=path Else destinationpath=path & "\" End If ' =========================================== ' Convert document into DXL ' =========================================== dxl = exporter.Export(doc) ' ---=== for debugging ===--- ' Print "path=" &destinationPath ' f = Freefile ' Print "Debug output to " & destinationPath & "debug.dxl.txt" ' Open destinationPath & "debug.dxl.txt" For Output As f ' Print #f, DXL ' Close f ' ========================================= ' Remove CRs and LFs from DXL ' ========================================= dxl = Replace(dxl, Chr$(13), "") dxl = Replace(dxl, Chr$(10), "") ' =========================================== ' Extract picture data from DXL and write it into tempfile ' =========================================== For i=1 To 3 key = K(i,1) p1 = Instr(p1+10, dxl, key , 5) While p1>0 If p1 >0 Then p2 =Instr(p1, dxl, k(i,2), 5) If p2>0 Then dxlPictureType = K(i,3) dxlPicture = Mid$(dxl, p1+Len(key), p2-p1-Len(key)) ' ===================== ' Save DXL into tempfile ' ===================== f = Freefile Open destinationPath & "Base64.tmp" For Output As f Print #f, DXLPicture Close f ' =========================================== ' Create a new Notes Document with embedded picture ' =========================================== session.ConvertMIME = False Set Doc2 = New NotesDocument(ThisDB) Set MIMEEntity= doc2.CreateMIMEEntity Set stream = session.CreateStream If Not stream.Open(path & "Base64.tmp" , "binary") Then Messagebox "ExportPictures(): Open tempfile failed" Goto MyExit End If If stream.Bytes = 0 Then Messagebox "ExportPictures(): Tempfile is empty" Goto MyExit End If Call MimeEntity.SetContentFromBytes(stream, "image/gif", ENC_BASE64) Call stream.Close ' ======================================= ' Save embedded picture to file ' ======================================= Set stream = session.CreateStream filename = destinationPath & doc.NoteID & "_" & counter & "." & dxlPictureType On Error Resume Next Kill filename On Error Goto err1 If Not stream.Open( filename, "binary") Then Messagebox "ExportPictures(): Cannot write picture " & filename Goto MyExit End If Set MIMEEntity = doc2.GetMIMEEntity Call MimeEntity.GetContentAsBytes(stream) Call stream.Close() FileList(counter) = filename counter=counter+1 End If ' p2>0 End If 'p1>0 p1 = Instr(p2+1, dxl, key , 5) Wend Next i MyExit: session.ConvertMIME = True ' Restore conversion On Error Resume Next Kill path & "Base64.tmp" Call stream.Close() On Error Goto err1 ExportPictures = FileList Exit Function err1: Print "ExportPictures(): " & Error$ & " in line " &Erl Messagebox "ExportPictures(): " & Error$ & " in line " &Erl session.ConvertMIME = True On Error Resume Next Kill path & "Base64.tmp" Call stream.Close() On Error Goto 0 Exit Function End Function 在具体的位置调用,比如:Sub Initialize On Error Goto er Dim session As New notessession Dim doc As notesdocument Set doc=session.Documentcontext Call ExportPictures(doc,"c:\dxl\") Exit Suber: Msgbox "错误行:"+Cstr(Erl())End Sub 如果是附加的图片附件,只需要使用extractembeddobject方法就行。