检查新收到的邮件是否有附件

Question

我是 VBA 的新手，我目前正在编写 VBA 代码来检查收到的新电子邮件是否有附件。如果不。它会向发件人发送一封电子邮件，说明他们发送的电子邮件没有附件。

附上代码。

Option Explicit
Sub checkAttachment(Item As Outlook.MailItem)
    Dim outAttachment As Outlook.Attachments
    Dim outerAttachment As Attachment
    Dim OutApp As Object
    Dim OutMail As Object

    If outAttachment = 0 Then
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    'On Error Resume Next

    With OutMail
    'recipient is the sender
    .To = "test@gmail.com"
    'auto-reply should be "RE : Subject of the message
    .Subject = "RE : "
    .CC = ""
    .BCC = ""`enter code here`
    .Body = "No attachment was found"
    .Display
    End With

    End If
    On Error GoTo 0
End Sub

尝试调整并奏效...现在我的问题是允许文件类型。我只希望 jpeg、tiff 和 pdf 被接受，除了它会发送附件是无效文件类型的消息

代码如下

    Option Explicit
    Public Sub CheckAttachment(Item As Outlook.MailItem)
        Dim olInspector As Outlook.Inspector
        Dim olDocument As Outlook.DocumentItem
        Dim olSelection As Outlook.Selection
        Dim objAtt As Outlook.Attachment
        Dim ft As FileTypes
        Dim olReply As MailItem
        Dim FileExtension As String
        FileExtension = "jpeg, jpg, tiff, pdf"

        '// Check for attachment
        If Item.Attachments.Count > 1 Then
        GoTo CheckFileType1
            End If



    CheckFileType1:
        If Item.Attachments(Item.Attachments, ".tiff") Then
        GoTo CheckFileType2
        End If

    CheckFileType2:
        If Item.Attachments(Item.Attachments, ".jpeg") Then
        GoTo CheckFileType3
        End If

    CheckFileType3:
        If Item.Attachments(Item.Attachments, ".pdf") Then
        GoTo SendMail
        Else
        Exit Sub
        End If

    SendMail:
        Set olReply = Item.Reply '// Reply if no attachment found
        olReply.Body = "No attachment was found. Re-send the email and ensure that the needed file is attached." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & "This is a system generated message. No need to reply. Thank you."
        olReply.Send

        Set olInspector = Nothing
        Set olDocument = Nothing
        Set olSelection = Nothing


    End Sub

Answer 1

Set OutApp = CreateObject("Outlook.Application")

如果规则中的代码是运行，则无需创建新的 Outlook 应用程序实例。您可以改用应用程序属性。

to check if the new email received has an attachment or not

Attachments property of the MailItem class returns an Attachments object that represents all the attachments for the specified item. The Count 属性会告诉你附加物品的数量。请注意，邮件正文中显示的嵌入图像也可以视为附件。因此，您需要检查每个附件是否隐藏。您可以为此使用 PropertyAccessor 对象（请参阅附件 class 的相应属性）。您只需要获取 PR_ATTACHMENT_HIDDEN 属性值，DASL 名称为 http://schemas.microsoft.com/mapi/proptag/0x7FFE000B .

 Dim prop As String = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
 atc.PropertyAccessor.GetProperty(prop)

然后，如果需要，您可以发送 reply or create a new item. Instead of the Display method you need to use the Send 个。

Answer 2

这应该有效。

Option Explicit
Public Sub CheckAttachment(Item As Outlook.MailItem)
    Dim olInspector As Outlook.Inspector
    Dim olDocument As Word.Document
    Dim olSelection As Word.Selection
    Dim olReply As MailItem

    '// Check for attachment
    If Item.Attachments.Count > 0 Then
        Exit Sub
    Else
        Set olReply = Item.Reply '// Reply if no attachment found
        olReply.Display
    End If

    Set olInspector = Application.ActiveInspector()
    Set olDocument = olInspector.WordEditor
    Set olSelection = olDocument.Application.Selection

    olSelection.InsertBefore "No attachment was found, Thank you."

    '// Send
    olReply.Send

    Set olInspector = Nothing
    Set olDocument = Nothing
    Set olSelection = Nothing
End Sub

检查新收到的邮件是否有附件

Checking if newly received email has an attachment

outlook

vba