Outlook 附件检查

Question

如何制作 VBA 代码或以某种方式设置我的邮件，以便在我发送带附件的电子邮件时显示消息框？我搜索了很多帖子，但没有找到解决此问题的方法 - 我找到了很多检查丢失附件的解决方案，但到目前为止，我还没有找到一个在电子邮件有附件时显示警报的解决方案。

Answer 1

我会参考 https://docs.microsoft.com/en-us/office/vba/api/Outlook.Application.ItemSend

和

以及https://social.msdn.microsoft.com/Forums/sqlserver/en-US/c4f47790-8e7b-425a-bf7e-f7bc5b725e81/determine-attechments-in-mail-item?forum=outlookdev

这些使用下面显示的示例详细说明了 ItemSend 事件。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
prompt = "Are you sure you want to send " & Item.Subject & "?"
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
    Cancel = True
    End If
End Sub

您要查找的MailItem中的属性是Attachments。

以上示例将 Item 作为对象传递 - 默认情况下应为 MailItem，因此如果它有附件，则检查 Item.Attachments.Count <> 0 为真。

尝试

Private Sub Application_ItemSend(ByVal Item as Object, Cancel as Boolean)
If Item.Attachments.Count > 0 Then
   If Msgbox("Items attached to email. Send?", vbYesNo) = vbNo Then
     Cancel = True
   End If
End If
End Sub

要仅在主题行标记带有附件的邮件，我们可以使用附件属性 "PR_ATTACHMENT_HIDDEN" 如果它存在且值为 FALSE，则表示在主题行附有附件而不是嵌入图像。

如果 PR_ATTACHMENT_HIDDEN 不在任何对象上，快速 On Error Resume Next 是捕获异常。如果不存在就会抛出异常

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Const PR_ATTACHMENT_HIDDEN As String = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"

Dim aFound As Boolean

aFound = False

    If TypeOf Item Is Outlook.MailItem Then

        For Each a In Item.Attachments
            On Error Resume Next ' to avoid the error thrown when no items within attachments have this property

            If a.PropertyAccessor.GetProperty(PR_ATTACHMENT_HIDDEN) = False Then
                aFound = True
                Exit For
            End If

            On Error GoTo 0
         Next a

        If aFound = True Then
            If MsgBox("Items attached to email. Send?", vbYesNo) = vbNo Then
                Cancel = True
            End If
        End If
    End If
End Sub

如果您试图区分签名中的图像和嵌入的图像，我们需要根据标签的 HTML 电子邮件正文检查内容 ID。我在代码中添加了另一个检查以找到那些并将它们视为误报。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Const PR_ATTACH_CONTENT_ID As String = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Const PR_ATTACHMENT_HIDDEN As String = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"

Dim aFound As Boolean

aFound = False

    If TypeOf Item Is Outlook.MailItem Then

        For Each a In Item.Attachments
            On Error Resume Next ' to avoid the error thrown when no items within attachments have this property
            If a.PropertyAccessor.GetProperty(PR_ATTACHMENT_HIDDEN) = False Then
                If Len(a.PropertyAccessor.GetProperty(PR_ATTACH_CONTENT_ID)) > 0 And InStr(Application.ActiveInspector.CurrentItem.HTMLBody, a.PropertyAccessor.GetProperty(PR_ATTACH_CONTENT_ID)) Then
                Else
                aFound = True
                Exit For
                End If
            End If

            On Error GoTo 0
         Next a

        If aFound = True Then
            If MsgBox("Items attached to email. Send?", vbYesNo) = vbNo Then
                Cancel = True
            End If
        End If
    End If
End Sub

Outlook 附件检查

Outlook attachment check

vba

email

outlook

attachment

email-attachments