Lotus Notes代理 - 刪除嵌入的圖像？

Question

我有某人共享年前代理這需要附加的文件，將它們保存到我的硬盤驅動器，並從電子郵件中刪除。我用它來保留我的電子郵件一段時間，但留在我的企業郵箱配額下。我收到很多附件。

我現在發現，很多剩餘的大量電子郵件已嵌入圖像，而不是「附加文件」。任何人都可以共享一個實際上能夠使用嵌入式圖像執行的腳本（保存到硬盤，從電子郵件中刪除）？

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 

Answer 1

，這是非常有問題的腳本做，因爲它目前爲作爲MIME編碼圖像不會顯示爲使用EmbeddedObjects財產的任何類型的附件。

如果圖像內嵌存儲爲MIME消息的一部分，Notes客戶機將它們變成附連用於觀看，但是編程的只能作爲MIME消息的部分被訪問。它應該可以實現抓住與編碼（使用MIMEEntity班）的圖像的多部分MIME消息的正確部分，流這一點到光盤和重構原始文件（一個或多個），然後卸下這表示它的MIMEEntity（並把上空）。在

IBM Support Site

NotesMIMEEntity Class Documentation