LotusScript代理如何提取邮件正文中复制粘贴的内嵌图片？

我来帮你搞定这个问题！你当前的代码只能提取顶层嵌入对象（比如直接添加的附件、单独插入的图片），但那些在邮件正文中复制粘贴的内嵌图片，其实是嵌套在富文本的文本流里的，所以需要用NotesRichTextNavigator来遍历整个富文本内容，才能把这些隐藏的内嵌对象找出来。

问题根源 #

原来的item.EmbeddedObjects属性只会返回直接附着在富文本项顶层的对象，而那些和文本混排的内嵌图片属于富文本的元素节点，不在这个集合里，所以你的代码抓不到它们。

修改后的完整代码 #

下面是调整后的代码，用富文本导航器遍历所有嵌入对象，包括正文里的内嵌图片：

Dim session As New NotesSession
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim rtItem As NotesRichTextItem
Dim CurrentDocColl As NotesDocumentCollection
Dim rtNav As NotesRichTextNavigator
Dim rtObj As NotesEmbeddedObject
Dim pathname As String

' 替换成你要保存文件的本地路径，确保有写入权限
pathname = "C:\Your_Save_Directory"

Set db = Session.Currentdatabase
Set CurrentDocColl = db.Unprocesseddocuments
Set doc = CurrentDocColl.Getfirstdocument

While Not doc Is Nothing
    Set rtItem = doc.GetFirstItem("Body")
    If Not rtItem Is Nothing Then
        ' 创建富文本导航器，用于遍历所有元素
        Set rtNav = rtItem.CreateNavigator
        
        ' 定位第一个嵌入对象类型的元素
        If rtNav.FindFirstElement(RT_TYPE_OBJECT) Then
            Do
                Set rtObj = rtNav.GetEmbeddedObject
                If Not rtObj Is Nothing And rtObj.Name <> "" Then
                    ' 提取文件到指定路径
                    Call rtObj.ExtractFile(pathname & "\" & rtObj.Name)
                    ' 可选：打印日志确认提取成功
                    Print "已提取: " & rtObj.Name
                End If
            ' 继续查找下一个嵌入对象
            Loop While rtNav.FindNextElement(RT_TYPE_OBJECT)
        End If
    End If
    Set doc = CurrentDocColl.Getnextdocument(doc)
Wend

关键改进点 #

• 使用NotesRichTextNavigator：这个类可以遍历富文本中的所有元素，通过RT_TYPE_OBJECT筛选出所有嵌入对象（包括内嵌图片、文档对象等）。
• 遍历所有嵌入元素：通过FindFirstElement和FindNextElement循环，确保不会漏掉任何一个内嵌在文本里的对象。
• 增加有效性判断：检查rtObj是否为空以及是否有文件名，避免运行时错误。

可选优化 #

如果你只想提取图片文件，可以在提取前添加后缀判断：

Dim ext As String
ext = LCase(Right(rtObj.Name, 4))
If ext = ".jpg" Or ext = ".png" Or ext = ".gif" Or ext = ".bmp" Then
    Call rtObj.ExtractFile(pathname & "\" & rtObj.Name)
End If

这样就能精准提取你需要的图片类型啦！

内容的提问来源于stack exchange，提问作者Q. Suisse