Проверка вложений в Outlook

Question

Как мне сделать код VBA или настроить свою почту таким образом, чтобы отображалось окно сообщения, если я отправляю электронное письмо с вложением? Я просмотрел много сообщений и не нашел решения этой проблемы - я нашел много решений для проверки отсутствующих вложений, но до сих пор я не нашел ни одного, где бы показывалось предупреждение, если в письме есть вложение.

Answer 1

Я бы сослался https://docs.microsoft.com/en-us/office/vba/api/Outlook.Application.ItemSend

и Как автоматически запустить макрос при отправке электронного письма в Outlook?

, а также 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 отсутствует на каких-либо объектах. Вызовет исключение, если его не существует.

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 электронного письма для тега. Я добавил еще одну проверку в код, чтобы найти их и игнорировать их как ложные срабатывания.

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