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

设置OutApp = CreateObject（＆＃34; Outlook.Application＆＃34;）

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

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

MailItem类的Attachments属性返回一个Attachments对象，该对象表示指定项的所有附件。 Count属性会告诉您附加项目的数量。请注意，邮件正文中显示的嵌入图像也可以视为附件。因此，您需要检查每个附件是否隐藏。您可以使用PropertyAccessor对象（请参阅Attachment类的相应属性）。您只需要获取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或创建新项目。您需要使用Send一个而不是Display方法。

Answer 2

This should work.

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

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

2 个答案: