我有超过1k的电子邮件,所有电子邮件都附有大尺寸的图片,我想减小尺寸(如1024x800文件大小)。
通常我所做的是在编辑模式下打开信息然后打开图片然后减小尺寸最后保存信息,这是一个很长的过程。
所以我在vba中寻找一些东西 Save and remove attachments from email items (VBA)
Sub SaveAttachment()
'Declaration
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
'Ask for destination folder
myOrt = InputBox("Destination", "Save Attachments", "C:\")
On Error Resume Next
'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
'for all items do...
For Each myItem In myOlSel
'point on attachments
Set myAttachments = myItem.Attachments
'if there are some...
If myAttachments.Count > 0 Then
'add remark to message text
myItem.Body = myItem.Body & vbCrLf & _
"Removed Attachments:" & vbCrLf
'for all attachments do...
For i = 1 To myAttachments.Count
'save them to destination
myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName
'add name and destination to message text
myItem.Body = myItem.Body & _
"File: " & myOrt & _
myAttachments(i).DisplayName & vbCrLf
Next i
'for all attachments do...
While myAttachments.Count > 0
'remove it (use this method in Outlook XP)
'myAttachments.Remove 1
'remove it (use this method in Outlook 2000)
myAttachments(1).Delete
Wend
'save item without attachments
myItem.Save
End If
Next
'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
End Sub
注意:我必须保留大幅图片至少一个月后我想减少图片尺寸,所以我无法设置任何选项,我收到较小尺寸的电子邮件。
答案 0 :(得分:0)
Outlook对象模型无法动态编辑附件。但是,作为一种解决方法,您可以使用低级属性来设置表示附加文件的字节数组。 Outlook对象模型中的PropertyAccessor类(请参阅Attachment类的相应属性)可用于检索PR_ATTACH_DATA_BIN属性值。 DASL名称为"http://schemas.microsoft.com/mapi/proptag/0x37010102"
。
Outlook对象模型允许使用Attachment类的SaveAsFile方法将附加文件保存在磁盘上,执行所需的更改并使用附件的Add方法重新附加它类。