CODEWITHSUNDEEP
vbaoutlook
AnotherCuriousKid
AnotherCuriousKid

Reputation: 101

Checking if newly received email has an attachment

I'm kinda new to VBA and I'm currently working on a VBA code to check if the new email received has an attachment or not. If not. It will send an email to the sender that the email they sent has no attachments.

Code is attached.

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 = "[email protected]"
    '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

Tried tweaking and it worked... now my problem is allowing file types. I only want jpeg, tiff and pdf to be accepted other than that it will send a message that the attachment is an invalid file type

Code goes like this

    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

Upvotes: 2

Views: 10213

Answers (2)

0m3r
0m3r

Reputation: 12495

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

Upvotes: 1

Eugene Astafiev
Eugene Astafiev

Reputation: 49453

Set OutApp = CreateObject("Outlook.Application")

There is no need to create a new Outlook Application instance if the code is run from the rule. You can use the Application property instead.

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

The Attachments property of the MailItem class returns an Attachments object that represents all the attachments for the specified item. The Count property will tell you the number of attached items. Be aware, the embedded images shown in the message body can be treated as an attachment as well. So, you need to check each attachment whether it is hidden or not. You can use the PropertyAccessor object for that (see the corresponding property of the Attachment class). You just need to get the PR_ATTACHMENT_HIDDEN property value, DASL name is http://schemas.microsoft.com/mapi/proptag/0x7FFE000B .

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

Then, if required, you can send a reply or create a new item. Instead of the Display method you need to use the Send one.

Upvotes: 4

Related Questions