我有一个多年前共享的代理人，它接收附件，将它们保存到我的硬盘中，然后将其从电子邮件中删除。我使用它来保留我的电子邮件一段时间但保持在我的公司邮箱配额下。我收到了很多附件。
我现在发现很多剩余的大型电子邮件都嵌入了图像而不是“附加文件”。任何人都可以共享一个实际上能够使用嵌入式图像执行相同操作的脚本（保存到硬盘驱动器，从电子邮件中删除）吗？
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
答案 0 :(得分：0)
这与目前的脚本非常有问题，因为MIME编码图像不会显示为使用EmbeddedObjects属性的任何类型的附件。
如果图像作为MIME消息的一部分内联存储，则Notes客户端会将它们转换为附件以供查看，但只能以编程方式将其作为MIME消息的一部分进行访问。应该可以使用编码的图像（使用MIMEEntity类）获取多部分MIME消息的正确部分，将其流式传输到光盘并重新构建原始文件然后删除代表它的MIMEEntity（并采取在空间上。）
的更多信息