• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Vba ignore signature when getting attachment details

Coz123

New Member
I'm working on a macro which checks the attachment name against the subject name and the domain. At the moment there's a couple of minor issues, I don't want the macro to recognise images in the signature as an attachment. I've tried to look online for solutions to this and things I've seen include using an if statement to work out the size, so for example only check attachments over 5kb etc. The other issue is, if there is no attachment at all, the macro falls over! I think I need another if statement in there at the end to do an item count but I'm not sure how that alters my conditions at the end of the macro!

Any help would be greatly appreciated! The code is below

Code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Dim outRecips As Outlook.Recipients
    Dim outRecip As Outlook.Recipient
    Dim outPropAcc As Outlook.PropertyAccessor

    Dim strDomain As String
    Dim lngPreDom As Long
    Dim lngPostDom As Long
    Dim strSubject As String

    Dim objAttachments As Outlook.Attachments
    Dim strAttachment As String

    Dim Response As String
'   set domain value

    Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

    Set outRecips = Item.Recipients

        For Each outRecip In outRecips
            Set outPropAcc = outRecip.PropertyAccessor
        
            strDomain = outPropAcc.GetProperty(PR_SMTP_ADDRESS)
            strDomain = Split(strDomain, "@")(1)
        
            lngPreDom = InStr(strDomain, "@")
            lngPostDom = InStr(strDomain, ".")
            
            strDomain = LCase(Mid(strDomain, lngPreDom + 1, lngPostDom - lngPreDom - 1))
            
        Exit For
        Next
            
'       set subject value
            
        strSubject = LCase(Item.Subject)
            
'       set attachment name
        
        Set objAttachments = Item.Attachments
        strAttachment = LCase(objAttachments.Item(1).FileName)
    
'       if external recipient, check email contents
    
        If strDomain <> "externaldomain" _
        Then
            If InStr(strSubject, strDomain) = 0 _
                Or InStr(strAttachment, strDomain) = 0 _
                Or InStr(strAttachment, strSubject) = 0 _
            Then
                Response = "Attachment/Subject do not match Recipient(s)" & vbNewLine & "Send Anyway?"
            
                If MsgBox(Response, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Recipients") = vbNo Then
                Cancel = True
                End If
            End If
        End If
End Sub
__________________________________________________________________
Mod edit : thread moved to appropriate forum !
 
Last edited by a moderator:
Back
Top