了解附件是嵌入还是附加

Question

我正在编写一个小的VBA以在列表框中显示电子邮件的所有附件。

用户可以选择应从电子邮件中删除并存储在目标文件夹中的附件。

我还在电子邮件中添加了一个HTML文件，其中包含所有已删除文件的列表(包括指向目标文件夹的每个文件的链接(。

我对图像有问题，因为它们可能是

• 作为普通文件附加到电子邮件
• 嵌入到电子邮件正文(如签名中的公司徽标(

我想在我的列表框中只显示那些作为文件附加到电子邮件的图像。

应忽略嵌入的邮件。

Sub SaveAttachment()
Dim myAttachments           As Outlook.Attachments
Dim olMailItem              As Outlook.MailItem
Dim lngAttachmentCount      As Long
Dim Attachment_Filename     As String
Select Case True
Case TypeOf Application.ActiveWindow Is Outlook.Inspector
Set olMailItem = Application.ActiveInspector.CurrentItem
Case Else
With Application.ActiveExplorer.Selection
If .Count Then Set olMailItem = .Item(1)
End With
If olMailItem Is Nothing Then Exit Sub
End Select
Set myAttachments = olMailItem.Attachments
If myAttachments.Count > 0 Then
For lngAttachmentCount = myAttachments.Count To 1 Step -1
'-------------------------------------------------------------------------
' Add the attachment to the list of attachments (form)
'-------------------------------------------------------------------------
Attachment_Filename = myAttachments(lngAttachmentCount).FileName
With UserForm1.lstAttachments
.AddItem (Attachment_Filename)
.List(lngAttachmentListPos, 1) = Attachment_Type_Text
.List(lngAttachmentListPos, 2) = FormatSize(myAttachments(lngAttachmentCount).Size) & " KB"
End With
Next lngAttachmentCount
End If
End Sub

我只添加了代码的相关部分，所以我希望我没有忘记任何东西。

目前我显示所有附件(也嵌入图像(。

如何确定是否嵌入了附件？

我在这里找到了一个可能的解决方案： 使用Outlook VBA
区分可见和不可见的附件 提供的源代码不起作用，似乎第 2 行和第 3 行中的两个 URL 不再存在。

Answer 1

我不确定这是否是在所有情况下都有效的解决方案，但它在我的环境中有效。这意味着"正确测试它"。

Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Function IsEmbedded(Att As Attachment) As Boolean
Dim PropAccessor As PropertyAccessor
Set PropAccessor = Att.PropertyAccessor
IsEmbedded = (PropAccessor.GetProperty(PR_ATTACH_CONTENT_ID) <> "")
End Function

调用它

If IsEmbedded(myAttachments(lngAttachmentCount)) Then
...
End If

看起来神秘的 url 常量不是 url，而是一个属性标识符。您可以在此处找到它们的列表：https://interoperability.blob.core.windows.net/files/MS-OXPROPS/%5bMS-OXPROPS%5d.pdf

该属性设置为附件的 url(如果嵌入(。如果未嵌入，则为空。

Answer 2

在 Outlook 对象模型中，正确封送对象非常重要。让 PropertyAccessor 闲逛是不好的，所以我建议对接受的答案进行小幅修改，如下所示：

Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Function IsEmbedded(Att As Attachment) As Boolean
Dim PropAccessor As PropertyAccessor = Nothing
Try
PropAccessor = Att.PropertyAccessor
Return (PropAccessor.GetProperty(PR_ATTACH_CONTENT_ID) <> "")
Catch
Return False
Finally
If PropAccessor IsNot Nothing
Marshal.ReleaseCOMObject(PropAccessor)
End If
End Catch
End Function

Answer 3

在@DinahMoeHumm的答案和评论的帮助下，我们采用了这个似乎有效的解决方案：

Function outlook_att_IsEmbedded(Att As outlook.Attachment) As Boolean

Dim PropAccessor As outlook.PropertyAccessor

On Error GoTo outlook_att_IsEmbedded_error

outlook_att_IsEmbedded = False

Set PropAccessor = Att.PropertyAccessor

If PropAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001E") <> "" Or _
PropAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3713001E") <> "" Then

If PropAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x37140003") = 4 Then
outlook_att_IsEmbedded = True
End If
End If
outlook_att_IsEmbedded_exit:
Set PropAccessor = Nothing
Exit Function
outlook_att_IsEmbedded_error:
outlook_att_IsEmbedded = False
Resume outlook_att_IsEmbedded_exit

End Function

我不知道不同的概率是什么意思。或者 4 是什么。似乎你可以在这里找到它们的列表：https://interoperability.blob.core.windows.net/files/MS-OXPROPS/%5bMS-OXPROPS%5d.pdf(但我没有(