View Single Post
 
Old 03-20-2016, 10:56 AM
SerenityNetworks SerenityNetworks is offline Windows 10 Office 2016
Advanced Beginner
 
Join Date: May 2005
Location: Allen, Texas, USA
Posts: 37
SerenityNetworks
Default

This works perfectly for my needs. Thank you!

Code:
Option Explicit
    
'https://www.msofficeforums.com/outlook/30477-outlook-rule-not-send-if-attachment-name.html
'https://www.msofficeforums.com/member.php?u=26884

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim olAtt As Attachment
Dim strCheck As String
Dim bCheck As Boolean
    If Item.Attachments.Count > 0 Then
        For Each olAtt In Item.Attachments
            If olAtt.FileName Like "*File*.*" Then
                strCheck = Replace(olAtt.FileName, _
                                   Right(olAtt.FileName, _
                                         Len(olAtt.FileName) - _
                                         InStrRev(olAtt.FileName, _
                                                  Chr(46)) + 1), "")
                strCheck = Replace(strCheck, "File ", "")
                'Use the following line of code to assure Group/Distribution Name, Subject, and Attachment all contain the same keyword.
                'If InStr(1, Item.Subject, strCheck) = 0 Or Not Item.To = strCheck Then
                'Use the following line of code to only check that Subject and Attachment contain the same keyword.
                If InStr(1, Item.Subject, strCheck) = 0 Then
                    MsgBox "Check the attachment(s)!"
                    Cancel = True
                    Exit For
                End If
            End If
        Next olAtt
    End If
lbl_Exit:
    Exit Sub
End Sub
Reply With Quote