Lotus notes Lotus Notes代理-删除嵌入的图像？

我有一个几年前与某人共享的代理，该代理接收附件，将其保存到我的硬盘，并将其从电子邮件中删除。我用它来保存我的电子邮件一段时间，但不超过我的公司邮箱配额。我有很多附件

我现在发现，许多剩余的大型电子邮件都嵌入了图像，而不是附加文件。任何人都可以共享一个脚本，该脚本实际上可以执行相同的保存到硬盘驱动器、使用嵌入图像从电子邮件中删除的操作吗

FWIW，这是我用于分离附件的代理。原作者的道具，不知道是谁

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 

---

这对于脚本来说是非常有问题的，因为它当前的状态是MIME编码的图像不会显示为使用EmbeddedObjects属性的任何类型的附件

如果图像作为MIME消息的一部分内联存储，Notes客户端将把它们转换为附件以供查看，但以编程方式只能作为MIME消息的一部分进行访问。应该可以通过使用MIMEEntity类编码的图像获取多部分MIME消息的正确部分，将其流式输出到光盘并重新生成原始文件，然后删除表示它的MIMEEntity并占用空间

更多关于

---

感谢那些编辑我的代码/帖子的人。如果我对Jon关于编辑MIME实体的建议有任何进展，我将发布一个修改后的脚本。。。这次用正确的标记！