Avatar of Jose Rivera-Hernandez
Jose Rivera-Hernandez
Flag for United States of America asked on

Outlook Macro to delete emails not meeting keywords

I have an Outlook (2010) Macro that sends emails with certain keywords in them to the "Deleted Items" bin.  What I would like now is an Outlook macro that will move emails having certain key words (account, ssn, credit) to another folder and the rest to the "Deleted Items" bin. All these emails come from a defined account.

see the code that I am using right now.

Function UnwantedMessage(olkMsg As Outlook.MailItem) As Boolean
    'On the next line edit the keywords/phrases you want to filter out.  Use the | character to separate each word/phrase
    Const KEYWORDS = "Address change completed|Thank you for your interest in employment |Ad|Internet Explorer 8 Settings"
    Dim olkAtt As Outlook.Attachment, objRegEx As Object, colMatches As Object
    Set objRegEx = CreateObject("VBscript.RegExp")
    With objRegEx
        .IgnoreCase = False
        .Pattern = KEYWORDS
        .Global = True
    End With
    For Each olkAtt In olkMsg.Attachments
        If IsHiddenAttachment(olkAtt) Then
            Set colMatches = objRegEx.Execute(olkAtt.FileName)
            If colMatches.Count > 0 Then
                UnwantedMessage = True
                Exit For
            End If
        End If
    Next
    Set olkAtt = Nothing
    Set objRegEx = Nothing
    Set colMatches = Nothing
End Function

Open in new window

Microsoft ApplicationsVB ScriptOutlookRESTVisual Basic Classic

Avatar of undefined
Last Comment
gowflow

8/22/2022 - Mon
Brian McDonald

If the goal is to delete these items, then you might be able to do one better and stop them from even coming in, see the link below.

http://www.pei.com/2014/04/using-microsoft-exchange-to-block-social-security-numbers-from-being-sent-out/

You might be able to do a transport rule and prevent these types of messages from being accepted in the first place. Just a thought.
Jose Rivera-Hernandez

ASKER
Some will be reviewed the others will be deleted. You see we get thousands of emails for my department to review. 90% are false positives with no relevant content (sensitive) those need to be deleted and the 10% for us to review.

Let me explain, we have a system that encrypts outbound email based on a criteria that is met. However, the system isn't 100% effective since it can't analyze an email with a picture (that could have sensitive data) or a PDF file that is no-readable. Therefore my department is responsible to review all outbound emails that were not encrypted (because they didn't meet the criteria or the system failed to analyze and encrypt).

We get thousands of emails (a copy of the email is forwarded to us by the encryption system automatically) a day and we sift through them deleting those that we know for sure don't have any sensitive data for example "Out of Office", or coming from an email address that sends automated replies. That is the macro that I have now.

Now, I would like a macro that sifts through the emails with those keywords we have determine that are very likely to contain sensitive data, for example an email with the word "Account number", I want the macro to move these emails to an specific folder for us to review later and delete the rest of the emails that do not meet the criteria.

Thanks,
Bill Prew

Where is the code that actually uses the UnwantedMessage() function and currently does the delete?  That seems like the place you would want to add the move to a review folder logic.  Or have you not created any of that yet and need the delete logic and the move logic?

~bp
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
Jose Rivera-Hernandez

ASKER
this is all I have in the VB section of Outlook.

am I missing something?


Function UnwantedMessage(olkMsg As Outlook.MailItem) As Boolean
    'On the next line edit the keywords/phrases you want to filter out.  Use the | character to separate each word/phrase
    Const KEYWORDS = "bkupadmin@servicecu.org|resumes@servicecu.org|server.iad.liveperson.net|servicecu.notification@zixmessagecenter.com|noreply@pscu.com|ibpss@servicecu.org|Automatic reply|CID|Out of Office AutoReply|Accepted|Read|Message Recall Failure|ALERT: POSSIBLE FRAUD ACTIVITY|ALERT: FRAUD ACTIVITY DETECTED|Address change completed|Thank you for your interest in employment with Service Credit Union|Ad|Internet Explorer 8 Settings|Traps from Actifio cluster|Recall:|CU 4 Reality|Visa Chargeback|Intent To Sell Form|CU4Reality"
    Dim olkAtt As Outlook.Attachment, objRegEx As Object, colMatches As Object
    Set objRegEx = CreateObject("VBscript.RegExp")
    With objRegEx
        .IgnoreCase = False
        .Pattern = KEYWORDS
        .Global = True
    End With
    For Each olkAtt In olkMsg.Attachments
        If IsHiddenAttachment(olkAtt) Then
            Set colMatches = objRegEx.Execute(olkAtt.FileName)
            If colMatches.Count > 0 Then
                UnwantedMessage = True
                Exit For
            End If
        End If
    Next
    Set olkAtt = Nothing
    Set objRegEx = Nothing
    Set colMatches = Nothing
End Function

Public Function IsHiddenAttachment(olkAtt As Outlook.Attachment) As Boolean
    ' Purpose: Determines if an attachment is a hidden attachment.
    ' Written: 7/12/2012
    ' Author:  David Lee
    ' Outlook: 2007 and later
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Dim olkPA As Outlook.PropertyAccessor, varTemp As Variant
    On Error Resume Next
    Set olkPA = olkAtt.PropertyAccessor
    varTemp = olkPA.GetProperty(PR_ATTACH_CONTENT_ID)
    IsHiddenAttachment = (varTemp <> "")
    On Error GoTo 0
    Set olkPA = Nothing
End Function

Open in new window

Bill Prew

Yes, those are just two functions that can be called by other VBA code, and then the return from the function can be used to perform other logic.  Are you using Rules at all to process incoming emails?  Or how are you getting code to execute for emails now (or maybe you aren't yet)?

Is your intention to have something you can manually run on demand that scans the entire Inbox and moves or deletes emails based on the criteria in the function, or do you want each incoming email scanned immediately when it is received?

Also, looking at the code you have more closely, it looks like it is only testing the file names of hidden attachments against the regular expression list you have.  But based on the items in the list that doesn't feel like what you wanted.  Where did this code come from, did you write this?

When you posted the question you stated 'I have an Outlook (2010) Macro that sends emails with certain keywords in them to the "Deleted Items" bin.', is this actually true, do emails automatically get deleted today?  If so then there must be some additional code in play.

~bp
Jose Rivera-Hernandez

ASKER
I am only using a rule to move these emails to a particular folder, I prefer macros, they seem to be more customizable than rules.  I prefer a solution to do this as emails come in on the entire inbox (including folders that I create).

The system forwards the emails as an attachment that is why you see the code on hidden attachments.

Yes, emails matching the criteria in the "UnwantedMessage" function are going into the "Deleted Items" bin right now, where can I find the code other than where I found the function?

Thanks,
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
gowflow

Well I am looking at this question and seems it is spinning around.

1) It is good you post the whole code that you have in outlook. to do this choose from the developer menu Visual Basic.
2) You will see in the left side ThisOutlookSession if there is code there copy the whole thing and paste it here.
3) Also if you have a Module in the left pane doubleclick on it and also pate it here. Try to separate them when you paste in here so we know which is which.

gowflow
gowflow

ok you mention:

What I would like now is an Outlook macro that will move emails having certain key words (account, ssn, credit) to another folder and the rest to the "Deleted Items" bin. All these emails come from a defined account.

I need:
1) the defined account.
2) are the words "account" "ssn" "credit" exist in the body of the message or in the subject ?
3) are these words case sensitive ?
4) you mention: 'to another folder' : What is that folder ?
5) The rest: in Deleted item: Are you sure you want to delete all the rest ???

gowflow
gowflow

ok having not answered my previous message, and after having read all the threads in this question I saw that you need a macro that have a high search level possible for this this is what I have put in place:

1) Macro will look for these words (not case sensitive) in Subject, In the body of the message whether Text or HTML.
2) Macro will move to Deleted Folder all 'Incoming Mail' that these instances are not found.
3) Macro will move to a folder called @Review@ under the Inbox (that you will need to create before running this macro the first time and where all Incoming mail from any sender will have these 3 words or any combination of for your review and action.

Here is how to install this Macro:

1) Got o Visual Basic
2) Open ThisOutlookSession and doubleclick on it.
3) In the top left combobox you will find Application. Please select it.
4) on the Top right combobox open it and locate this Method and select it: NewMailEx
5) YOu will find if no code is there this:

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
End Sub

Open in new window


6) Please put this in between to have this:
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
FilterIncomingMessages EntryIDCollection
End Sub

Open in new window


7) Press Save on the Menu.
8) If you have a Module in the left pane doubleclick on it and after the last End Sub paste the below code in it.

Sub FilterIncomingMessages(EntryIDCollection As String)
Dim oDeletedItems As Outlook.Folder
Dim oMyFolderReview As Outlook.Folder

Dim varEntryIDs, vTargetWords
Dim oMail As MailItem
Dim sMailPart As String
Dim I As Integer, J As Integer, K As Integer, pos As Integer
Dim bFound As Boolean

'---> Set variables
vTargetWords = Array("account", "ssn", "credit")
varEntryIDs = Split(EntryIDCollection, ",")

'---> Obtain a reference to deleted items folder
Set oDeletedItems = Application.Session.GetDefaultFolder(olFolderDeletedItems)
'---> Obtain a reference to Specific folder to move found items
Set oMyFolderReview = Application.Session.GetDefaultFolder(olFolderInbox).Folders("@Review@")

'---> Process
For I = 0 To UBound(varEntryIDs)
    
    'Set oMail = oitem
    Set oMail = Application.Session.GetItemFromID(varEntryIDs(I))
    'Debug.Print "NewMailEx " & oMail.Subject
    
    For K = 1 To 3
        Select Case K
            Case 1
                sMailPart = LCase(oMail.Subject)
            Case 2
                sMailPart = LCase(oMail.Body)
            Case 3
                sMailPart = LCase(oMail.HTMLBody)
        
        
            For J = LBound(vTargetWords) To UBound(vTargetWords)
                pos = InStr(1, sMailPart, vTargetWords(J))
                If pos <> 0 Then
                    bFound = True
                    Exit For
                End If
            Next J
            If bFound Then Exit For
            
        End Select
    Next K
        
    '---> Move Mail depending on result
    If Not bFound Then
        oMail.Move oDeletedItems
    Else
        oMail.Move oMyFolderReview
    End If
Next I

End Sub

Open in new window


If You do not have a Module then right click on MyOutlookSession and choose Insert Module and paste the code above there.

9) SAVE On the Menu.
10) Close Outlook and if you are asked to save the new code say YES.
11) Create the @Review@ Folder under the Inbox
12) Check the mails

Let me know your comments.
gowflow
Your help has saved me hundreds of hours of internet surfing.
fblack61
gowflow

This is a newer version of the macro that will create the pending folder even if it is not there. No need to bother creating it.

IMPORTANT:
If you have multiple accounts in your mail this macro will not differentiate and will 'DELETE' all messages that do not have the 2 words or combination your looking for so

CAREFUL and advise the account you need to limit these checking before installing the macro or else you will have most of your mails DELETED !!!!!

Sub FilterIncomingMessages(EntryIDCollection As String)
Dim oDeletedItems As Outlook.Folder
Dim oMyFolderReview As Outlook.Folder

Dim varEntryIDs, vTargetWords
Dim oMail As MailItem
Dim sMailPart As String
Dim I As Integer, J As Integer, K As Integer, pos As Integer
Dim bFound As Boolean

'---> Set variables
vTargetWords = Array("account", "ssn", "credit")
varEntryIDs = Split(EntryIDCollection, ",")

'---> Obtain a reference to deleted items folder
Set oDeletedItems = Application.Session.GetDefaultFolder(olFolderDeletedItems)
'---> Obtain a reference to Specific folder to move found items
On Error Resume Next
Set oMyFolderReview = Application.Session.GetDefaultFolder(olFolderInbox).Folders("@Review@")
If oMyFolderReview Is Nothing Then
    Set oMyFolderReview = Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add("@Review@")
End If
On Error GoTo 0

'---> Process
For I = 0 To UBound(varEntryIDs)
    
    'Set oMail = oitem
    Set oMail = Application.Session.GetItemFromID(varEntryIDs(I))
    'Debug.Print "NewMailEx " & oMail.Subject
    
    For K = 1 To 3
        Select Case K
            Case 1
                sMailPart = LCase(oMail.Subject)
            Case 2
                sMailPart = LCase(oMail.Body)
            Case 3
                sMailPart = LCase(oMail.HTMLBody)
        
        
            For J = LBound(vTargetWords) To UBound(vTargetWords)
                pos = InStr(1, sMailPart, vTargetWords(J))
                If pos <> 0 Then
                    bFound = True
                    Exit For
                End If
            Next J
            If bFound Then Exit For
            
        End Select
    Next K
        
    '---> Move Mail depending on result
    If Not bFound Then
        oMail.Move oDeletedItems
    Else
        oMail.Move oMyFolderReview
    End If
Next I

End Sub

Open in new window


gowflow
Jose Rivera-Hernandez

ASKER
Gowflow

To your message (ID 42103760), all I posted in here is everything I have.

After reading your last message, it sounds that this will delete from multiple accounts if there are any. Well, I do have three accounts, the primary (infosecure@xyz.org) is the one that I would like to make these changes only.  

Could the macro just run on a folder that I have created already? I have other emails that come in to the primary inbox which do not originate from the account (zixgateway@xyz.org) and don't need this filtering that I would like to keep.

So what I am asking is for emails coming from zixgateway@xyz.org into my primary inbox (infosecure@xyz.org) to move to a folder (ZixMail), then run the macro sifting through all emails finding those that meet my criteria and move them to another folder (ZixReview) where we can review. I want the deletion to be done manually, this will avoid any issues.

Thank you,
gowflow

ok let me recap here with some questions:

1)you have mails coming from zixgateway@xyz.org that will be in the Inbox of infosecure@xyz.org this means:
Sender: zixgateway@xyz.org
Receipient: infosecure@xyz.org

2) What I can do is: Under your Inbox create 2 Folders that will be named as follows:
@ZixReview ---> All the mails that meet criteria 1 and previous name sequences found.
@ZixDelete  ---> All the mails that meet criteria 1 and no name sequence found.

Will this be ok ?
gowflow
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
Jose Rivera-Hernandez

ASKER
Yes on #1

Yes on #2

thanks
gowflow

ok here it is and please check it and let me know. Part 1 as already advised earlier on Thisoutlooksession this has not changed and part 2 is here:

Sub FilterIncomingMessages(EntryIDCollection As String)
Dim oDeletedItems As Outlook.Folder
Dim oMyFolderReview As Outlook.Folder

Dim varEntryIDs, vTargetWords
Dim oMail As MailItem
Dim sMailPart As String, sFrom As String, sReceive As String
Dim I As Integer, J As Integer, K As Integer, pos As Integer
Dim bFound As Boolean

'---> Set variables
vTargetWords = Array("account", "ssn", "credit")
varEntryIDs = Split(EntryIDCollection, ",")
sFrom = "zixgateway@xyz.org"
sReceive = "infosecure@xyz.org"

'---> Obtain a reference to specific deleted items folder
On Error Resume Next
Set oDeletedItems = Application.Session.GetDefaultFolder(olFolderInbox).Folders("@ZixDelete")
If oDeletedItems Is Nothing Then
    Set oDeletedItems = Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add("@ZixDelete")
End If
On Error GoTo 0

'---> Obtain a reference to Specific folder to move found items
On Error Resume Next
Set oMyFolderReview = Application.Session.GetDefaultFolder(olFolderInbox).Folders("@ZixReview")
If oMyFolderReview Is Nothing Then
    Set oMyFolderReview = Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add("@ZixReview")
End If
On Error GoTo 0

'---> Process
For I = 0 To UBound(varEntryIDs)
    
    'Set oMail = oitem
    Set oMail = Application.Session.GetItemFromID(varEntryIDs(I))
    'Debug.Print "NewMailEx " & oMail.Subject
    
    If sFrom = oMail.SenderEmailAddress And sReceive = oMail.To Then
    
        For K = 1 To 3
            Select Case K
                Case 1
                    sMailPart = LCase(oMail.Subject)
                Case 2
                    sMailPart = LCase(oMail.Body)
                Case 3
                    sMailPart = LCase(oMail.HTMLBody)
            
            
                For J = LBound(vTargetWords) To UBound(vTargetWords)
                    pos = InStr(1, sMailPart, vTargetWords(J))
                    If pos <> 0 Then
                        bFound = True
                        Exit For
                    End If
                Next J
                If bFound Then Exit For
                
            End Select
        Next K
            
        '---> Move Mail depending on result
        If Not bFound Then
            oMail.Move oDeletedItems
        Else
            oMail.Move oMyFolderReview
        End If
    End If
    
Next I

End Sub

Open in new window


Forgot to mention: ANY Mail that is received in your outlook where either
From is not: zixgateway@xyz.org
OR
To is not: infosecure@xyz.org

Will NOT be processed by this macro and will follow its normal route.

IE to be processed by this macro it has to have:
From = zixgateway@xyz.org
AND
To = infosecure@xyz.org



gowflow
Jose Rivera-Hernandez

ASKER
will test and let you know!
thanks
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
gowflow

ok when u expect this ? as running multiple issues here and to test urs I apply it to my outlook which is a 'pain' !!! :)
gowflow
Jose Rivera-Hernandez

ASKER
ok so here is what I have under "ThisOutloookSession"  with this new code:

When I run it, I get a Sub or Function not defined error.

Function UnwantedMessage(olkMsg As Outlook.MailItem) As Boolean
    'On the next line edit the keywords/phrases you want to filter out.  Use the | character to separate each word/phrase
    Const KEYWORDS = "bkupadmin@servicecu.org|resumes@servicecu.org|server.iad.liveperson.net|servicecu.notification@zixmessagecenter.com|noreply@pscu.com|ibpss@servicecu.org|Automatic reply|CID|Out of Office AutoReply|Accepted|Read|Message Recall Failure|ALERT: POSSIBLE FRAUD ACTIVITY|ALERT: FRAUD ACTIVITY DETECTED|Address change completed|Thank you for your interest in employment with Service Credit Union|Ad|Internet Explorer 8 Settings|Traps from Actifio cluster|Recall:|CU 4 Reality|Visa Chargeback|Intent To Sell Form|CU4Reality"
    Dim olkAtt As Outlook.Attachment, objRegEx As Object, colMatches As Object
    Set objRegEx = CreateObject("VBscript.RegExp")
    With objRegEx
        .IgnoreCase = False
        .Pattern = KEYWORDS
        .Global = True
    End With
    For Each olkAtt In olkMsg.Attachments
        If IsHiddenAttachment(olkAtt) Then
            Set colMatches = objRegEx.Execute(olkAtt.FileName)
            If colMatches.Count > 0 Then
                UnwantedMessage = True
                Exit For
            End If
        End If
    Next
    Set olkAtt = Nothing
    Set objRegEx = Nothing
    Set colMatches = Nothing
End Function

Public Function IsHiddenAttachment(olkAtt As Outlook.Attachment) As Boolean
    ' Purpose: Determines if an attachment is a hidden attachment.
    ' Written: 7/12/2012
    ' Author:  David Lee
    ' Outlook: 2007 and later
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Dim olkPA As Outlook.PropertyAccessor, varTemp As Variant
    On Error Resume Next
    Set olkPA = olkAtt.PropertyAccessor
    varTemp = olkPA.GetProperty(PR_ATTACH_CONTENT_ID)
    IsHiddenAttachment = (varTemp <> "")
    On Error GoTo 0
    Set olkPA = Nothing
End Function


Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
FilterIncomingMessages EntryIDCollection
End Sub

Open in new window



and this is what i have under Module 1

Sub UnwantedMessages()

End Sub


Sub FilterIncomingMessages(EntryIDCollection As String)
Dim oDeletedItems As Outlook.Folder
Dim oMyFolderReview As Outlook.Folder

Dim varEntryIDs, vTargetWords
Dim oMail As MailItem
Dim sMailPart As String, sFrom As String, sReceive As String
Dim I As Integer, J As Integer, K As Integer, pos As Integer
Dim bFound As Boolean

'---> Set variables
vTargetWords = Array("Acc Num", "Mem Num", "Mbr Num", "Lo Num", "Ch Num", "SSN", "Social Sec", "Driver Lic", "Photo ID", "Passport", "Network", "Password", "Passphrase", ".pdf", ".ppt", ".docx", ".xls", ".vsd", ".zip", ".accdb", ".accde", ".rtf", ".xml")
varEntryIDs = Split(EntryIDCollection, ",")
sFrom = "zixvpmgateway@servicecu.org"
sReceive = "infosecure@servicecu.org"

'---> Obtain a reference to specific deleted items folder
On Error Resume Next
Set oDeletedItems = Application.Session.GetDefaultFolder(olFolderInbox).Folders("@ZixDelete")
If oDeletedItems Is Nothing Then
    Set oDeletedItems = Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add("@ZixDelete")
End If
On Error GoTo 0

'---> Obtain a reference to Specific folder to move found items
On Error Resume Next
Set oMyFolderReview = Application.Session.GetDefaultFolder(olFolderInbox).Folders("@ZixReview")
If oMyFolderReview Is Nothing Then
    Set oMyFolderReview = Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add("@ZixReview")
End If
On Error GoTo 0

'---> Process
For I = 0 To UBound(varEntryIDs)
    
    'Set oMail = oitem
    Set oMail = Application.Session.GetItemFromID(varEntryIDs(I))
    'Debug.Print "NewMailEx " & oMail.Subject
    
    If sFrom = oMail.SenderEmailAddress And sReceive = oMail.To Then
    
        For K = 1 To 3
            Select Case K
                Case 1
                    sMailPart = LCase(oMail.Subject)
                Case 2
                    sMailPart = LCase(oMail.Body)
                Case 3
                    sMailPart = LCase(oMail.HTMLBody)
            
            
                For J = LBound(vTargetWords) To UBound(vTargetWords)
                    pos = InStr(1, sMailPart, vTargetWords(J))
                    If pos <> 0 Then
                        bFound = True
                        Exit For
                    End If
                Next J
                If bFound Then Exit For
                
            End Select
        Next K
            
        '---> Move Mail depending on result
        If Not bFound Then
            oMail.Move oDeletedItems
        Else
            oMail.Move oMyFolderReview
        End If
    End If
    
Next I

End Sub

Open in new window


is this correct?  The folders were created, but don't see any of the messages coming from the specified account moving to any folder. I also don't see the other function in Part 1 executing.

Thanks,

Thanks,
Jose Rivera-Hernandez

ASKER
correction Part 1 seems to be running normally. Emails meeting that criteria in the first Part are being sent to the Deleted Items.
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
gowflow

I don't understand. You have a problem or it is working fine ?
gowflow
Jose Rivera-Hernandez

ASKER
it's not working.

is the "ThisOutlookSession" and "Module1" correct?
ASKER CERTIFIED SOLUTION
gowflow

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
Jose Rivera-Hernandez

ASKER
so it appears to work partially, some emails coming from the email account are not moving to either folder (review or delete), in fact no emails are moved to the Delete folder; however some are moved to the DeletedItems very likely those in the first function.

I am not sure if I mention this, but the emails come in as an attached email and that is why you notice the Public Function "HidenAttachment". could it be that the new function isn't looking in the attached email?

thanks,
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
gowflow

yes for sure it doesn't spot those that are an attachment cos nothing is mentioned neither in Subject nor in the body not in bodyHTML !!! How could I guess ??

If you want me to look into that and need a full solution then I need you to post few emails that comes in that were not spoted. If you feel some info is confidential and don't want to post it here. Don't know if by messaging me you can post there ? or else you have no choice but to post here.

I will need to test those.
gowflow
Jose Rivera-Hernandez

ASKER
I sent you a copy of the email.
thanks,
gowflow

no attachment found
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
Jose Rivera-Hernandez

ASKER
I have uploaded it, sorry about that.
gowflow

ok well rcvd. I will test it later on and find a fix for that.
will revert
gowflow
gowflow

ok try this

Sub FilterIncomingMessages(EntryIDCollection As String)
Dim oDeletedItems As Outlook.Folder
Dim oMyFolderReview As Outlook.Folder

Dim varEntryIDs, vTargetWords
Dim oMail As MailItem
Dim sMailPart As String, sFrom As String, sReceive As String
Dim I As Integer, J As Integer, K As Integer, pos As Integer
Dim bFound As Boolean

'---> Set variables
vTargetWords = Array("Acc Num", "Mem Num", "Mbr Num", "Lo Num", "Ch Num", "SSN", "Social Sec", "Driver Lic", "Photo ID", "Passport", "Network", "Password", "Passphrase", ".pdf", ".ppt", ".docx", ".xls", ".vsd", ".zip", ".accdb", ".accde", ".rtf", ".xml")
varEntryIDs = Split(EntryIDCollection, ",")
sFrom = "zixvpmgateway@servicecu.org"
sReceive = "infosecure@servicecu.org"

'---> Obtain a reference to specific deleted items folder
On Error Resume Next
Set oDeletedItems = Application.Session.GetDefaultFolder(olFolderInbox).Folders("@ZixDelete")
If oDeletedItems Is Nothing Then
    Set oDeletedItems = Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add("@ZixDelete")
End If
On Error GoTo 0

'---> Obtain a reference to Specific folder to move found items
On Error Resume Next
Set oMyFolderReview = Application.Session.GetDefaultFolder(olFolderInbox).Folders("@ZixReview")
If oMyFolderReview Is Nothing Then
    Set oMyFolderReview = Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add("@ZixReview")
End If
On Error GoTo 0

'---> Process
For I = 0 To UBound(varEntryIDs)
    
    'Set oMail = oitem
    Set oMail = Application.Session.GetItemFromID(varEntryIDs(I))
    'Debug.Print "NewMailEx " & oMail.Subject
    
    If sFrom = oMail.SenderEmailAddress And sReceive = oMail.To Then
    
        For K = 1 To 3
            Select Case K
                Case 1
                    sMailPart = LCase(oMail.Subject)
                Case 2
                    sMailPart = LCase(oMail.Body)
                Case 3
                    sMailPart = LCase(oMail.HTMLBody)
            
            
                For J = LBound(vTargetWords) To UBound(vTargetWords)
                    pos = InStr(1, sMailPart, vTargetWords(J))
                    If pos <> 0 Then
                        bFound = True
                        Exit For
                    End If
                Next J
                If bFound Then Exit For
                
            End Select
        Next K
            
        '---> Check attachment only if not found
        If Not bFound Then
            If UnwantedMessage(oMail) Then
                bFound
            End If
        End If
        
        '---> Move Mail depending on result
        If Not bFound Then
            oMail.Move oDeletedItems
        Else
            oMail.Move oMyFolderReview
        End If
    End If
    
Next I

End Sub

Open in new window



gowflow
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
Jose Rivera-Hernandez

ASKER
I am getting an error in this piece - it highlights "bFound".  Error is "Compile Error"  Expected Sub, Function, or Property.

Check attachment only if not found
        If Not bFound Then
            If UnwantedMessage(oMail) Then
                bFound
            End If
        End If

Open in new window


thanks,
gowflow

yes I don't know how you copy code !!! the title shoulc be like this:
'---> Check attachment only if not found

Note the single Quote in the beginning to notify the compiler that this is a comment not to be processed. you have it like this:
Check attachment only if not found

Compiler assume this is a function of some sort and as it did not find it it thru the error. Just put a single quote at the beg.
gowflow
Jose Rivera-Hernandez

ASKER
nope still same issue, the quote was there.
See screenshot of the code.

I modified it to read "bfound = True" and the error stopped, but I am not sure if this is correct.

'---> Check attachment only if not found
        If Not bFound Then
            If UnwantedMessage(oMail) Then
                bFound = True
            End If
        End If

Open in new window


However, the code isn't working even with this change I made.
Image-2.png
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
gowflow

Sorry your driving me Waco here !!!!
Look at your error in yellow !!! its missing the True !!!!

PLease the code for this para should be what you posted and nothing else !!!!

'---> Check attachment only if not found
        If Not bFound Then
            If UnwantedMessage(oMail) Then
                bFound = True
            End If
        End If

Open in new window


gowflow
Jose Rivera-Hernandez

ASKER
here it is

     
   '---> Check attachment only if not found
        If Not bFound Then
            If UnwantedMessage(oMail) Then
                bFound = True
            End If
        End If

Open in new window

gowflow

ok so its working or what ?
gowflow
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
Jose Rivera-Hernandez

ASKER
No it is not.

Messages are not sent to either folder, they remain in the inbox.
gowflow

PLease post here all the code that you have breaking them by section: like

1) ThisOutlooksession
2) Module1

in separate Codes. This code is working perfectly on my machine so sure something not correctly installed your end.
gowflow
Jose Rivera-Hernandez

ASKER
Here is the "ThisOutlookSession"

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
FilterIncomingMessages EntryIDCollection
End Sub

Open in new window


Here is the "Module1"

Function UnwantedMessage(olkMsg As Outlook.MailItem) As Boolean
    'On the next line edit the keywords/phrases you want to filter out.  Use the | character to separate each word/phrase
    Const KEYWORDS = "bkupadmin@servicecu.org|resumes@servicecu.org|server.iad.liveperson.net|servicecu.notification@zixmessagecenter.com|noreply@pscu.com|ibpss@servicecu.org|Automatic reply|Automatic reply:|CID|(CID:|automatic acknowledgement|Out of Office AutoReply|Accepted|Read|Recall:|Message Recall Failure|ALERT: POSSIBLE FRAUD ACTIVITY|ALERT: FRAUD ACTIVITY DETECTED|Address change completed|Accepted:|Thank you for your interest in employment with Service Credit Union|Ad|Traps from Actifio cluster|Recall:|CU 4 Reality|Visa Chargeback|Intent To Sell Form|CU4Reality"
    Dim olkAtt As Outlook.Attachment, objRegEx As Object, colMatches As Object
    Set objRegEx = CreateObject("VBscript.RegExp")
    With objRegEx
        .IgnoreCase = False
        .Pattern = KEYWORDS
        .Global = True
    End With
    For Each olkAtt In olkMsg.Attachments
        If IsHiddenAttachment(olkAtt) Then
            Set colMatches = objRegEx.Execute(olkAtt.FileName)
            If colMatches.Count > 0 Then
                UnwantedMessage = True
                Exit For
            End If
        End If
    Next
    Set olkAtt = Nothing
    Set objRegEx = Nothing
    Set colMatches = Nothing
End Function


Public Function IsHiddenAttachment(olkAtt As Outlook.Attachment) As Boolean
    ' Purpose: Determines if an attachment is a hidden attachment.
    ' Written: 7/12/2012
    ' Author:  David Lee
    ' Outlook: 2007 and later
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Dim olkPA As Outlook.PropertyAccessor, varTemp As Variant
    On Error Resume Next
    Set olkPA = olkAtt.PropertyAccessor
    varTemp = olkPA.GetProperty(PR_ATTACH_CONTENT_ID)
    IsHiddenAttachment = (varTemp <> "")
    On Error GoTo 0
    Set olkPA = Nothing
End Function


Sub FilterIncomingMessages(EntryIDCollection As String)
Dim oDeletedItems As Outlook.Folder
Dim oMyFolderReview As Outlook.Folder

Dim varEntryIDs, vTargetWords
Dim oMail As MailItem
Dim sMailPart As String, sFrom As String, sReceive As String
Dim I As Integer, J As Integer, K As Integer, pos As Integer
Dim bFound As Boolean

'---> Set variables
vTargetWords = Array("Acc Num", "Mem Num", "Mbr Num", "Lo Num", "Ch Num", "SSN", "Social Sec", "Driver Lic", "Photo ID", "Passport", "Network", "Password", "Passphrase", ".pdf", ".ppt", ".docx", ".xls", ".vsd", ".zip", ".accdb", ".accde", ".rtf", ".xml")
varEntryIDs = Split(EntryIDCollection, ",")
sFrom = "zixvpmgateway@servicecu.org"
sReceive = "infosecure@servicecu.org"

'---> Obtain a reference to specific deleted items folder
On Error Resume Next
Set oDeletedItems = Application.Session.GetDefaultFolder(olFolderInbox).Folders("ZixDelete")
If oDeletedItems Is Nothing Then
    Set oDeletedItems = Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add("ZixDelete")
End If
On Error GoTo 0

'---> Obtain a reference to Specific folder to move found items
On Error Resume Next
Set oMyFolderReview = Application.Session.GetDefaultFolder(olFolderInbox).Folders("Zix Emails")
If oMyFolderReview Is Nothing Then
    Set oMyFolderReview = Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add("Zix Emails")
End If
On Error GoTo 0

'---> Process
For I = 0 To UBound(varEntryIDs)
    
    'Set oMail = oitem
    Set oMail = Application.Session.GetItemFromID(varEntryIDs(I))
    'Debug.Print "NewMailEx " & oMail.Subject
    
    If sFrom = oMail.SenderEmailAddress And sReceive = oMail.To Then
    
        For K = 1 To 3
            Select Case K
                Case 1
                    sMailPart = LCase(oMail.Subject)
                Case 2
                    sMailPart = LCase(oMail.Body)
                Case 3
                    sMailPart = LCase(oMail.HTMLBody)
            
            
                For J = LBound(vTargetWords) To UBound(vTargetWords)
                    pos = InStr(1, sMailPart, vTargetWords(J))
                    If pos <> 0 Then
                        bFound = True
                        Exit For
                    End If
                Next J
                If bFound Then Exit For
                
            End Select
        Next K
    
        '---> Check attachment only if not found
        If Not bFound Then
            If UnwantedMessage(oMail) Then
                bFound = True
            End If
        End If
        
        '---> Move Mail depending on result
        If Not bFound Then
            oMail.Move oDeletedItems
        Else
            oMail.Move oMyFolderReview
        End If
    End If
    
Next I

End Sub

Open in new window

⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
gowflow

ok try this change in Sub FilterIncomingMessage.

Please replace this instruction:
pos = InStr(1, sMailPart, vTargetWords(J))

by this instruction:
pos = InStr(1, sMailPart, LCase(vTargetWords(J)))

Press Save on outlook.
Exit Outlook and if you are prompt to save the VBS project say YES
Start Outlook and try If it works.

Please note that for emails to be trapped by this procedure it is important that in the email:
The from to be: "zixvpmgateway@servicecu.org"
and the To be: "infosecure@servicecu.org"

If both are not this address or one of them is not this address then they will not fall in the selected folder for Review and Delete and the email will naturally land in the Inbox. This is the mandatory condition.

Let me know
gowflow
Jose Rivera-Hernandez

ASKER
ok change has been done , waiting for new incoming emails from "zixvpmgateway@..." to check if this works.
gowflow

ok keep me posted. Maybe will need to work on the attachment not sure how your existing procedure will behave ... but will see.
gowflow
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
Jose Rivera-Hernandez

ASKER
not working. Now the UnwantedMessage function isn't working at all.

is it possible that I use an Outlook rule to move all incoming emails to the "Zix Emails" folder (so without the Sub FilteringIncomingMessages to do it) then your Sub to do the filtering in and removing everything that doesn't meet the criteria to the ZixDelete folder?

My UnwantedMessage function was working before, looking at the attachment and deleting those that met the criteria in the function.  

Thanks,
gowflow

ok don't know the behavior of UnwantedMessage  so we are going to cancel this new part and please confirm to me that still it is working ... with exception so we see how to circumvent this.

Change this part
'---> Check attachment only if not found
        If Not bFound Then
            If UnwantedMessage(oMail) Then
                bFound = True
            End If
        End If

Open in new window


To be like this:
'---> Check attachment only if not found
'        If Not bFound Then
'            If UnwantedMessage(oMail) Then
'                bFound = True
'            End If
'        End If

Open in new window


Simply Add a single Quote in the beginning of each line or delete the current routine you have and replace it by this one. Only this part.

Let me know if after this change it works like before, like except some files that are with attachments. then I will change the routine to send to the review all files with attachments this will be the best way.

Let me know first.
gowflow
Jose Rivera-Hernandez

ASKER
I have added a single quote as shown and waiting to see if the UnwantedMessage function resumes working.
thanks
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
gowflow

ok great will wait to hear from you so to know how to handle this part. Meantime please explain to me this:

When you have an 'Unwanted' message coming in what is the behavior now ? the email goes to your inbox or what ???

gowflow
Jose Rivera-Hernandez

ASKER
nothing seems to work now.

'Unwanted' messages come in the 'infosecure' inbox then I have a rule to move all emails coming from the 'zixvpmgateway' to the 'Zix Emails' folder, but the initial code I had there was moving the 'Unwanted' messages to the deleted items without any intervention.

I don't know whether moving the emails to the 'Zix Emails' was necessary for it would work if I didn't move them, but now that is not working either and I have removed your code only leaving what I had before, but honestly we have done so many changes that I can't remember how it was before.

I am at a loss.
Jose Rivera-Hernandez

ASKER
Here is the link on the assistance I received in the past to create the first part, maybe you get an idea of what I accomplished first. I recopied this code but it's not working, I can't remember if I modified anything but it was working before.

https://www.experts-exchange.com/questions/28030144/MS-Outlook-search-for-attachments-with-certain-subjects.html#comments
Your help has saved me hundreds of hours of internet surfing.
fblack61
gowflow

Well the problem is that you have also rules intervening .... in between and on top you decided to change the name of folders in this macro to maybe already existing folder which add confusion and dis-orientation to the whole issue.

Anyway I check the previous question and was very surprised to noticed this piece of code that you completely 'Removed' from the all the code here that make the whole difference and maybe this is why it is not working !!! I do not mean to say that My macro will work but first I will ask you to reinstate the following then if you are at the stage where you first started this question then I will see how to incorporate my macro.

NOTE:
You should be very cautious when you paste code and pasting part of code may result in wrong execution of code.


A - This Is the Code that you missed to post in this question
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim arrEID As Variant, varEid As Variant, olkMsg As Object
    arrEID = Split(EntryIDCollection, ",")
    For Each varEid In arrEID
        Set olkMsg = Session.GetItemFromID(varEid)
        If olkMsg.Class = olMail Then
            If UnwantedMessage(olkMsg) Then
                'On the next line change the name of the folder the unwanted messages will be move to.  That folder must be under the Inbox folder.
                olkMsg.Move Session.GetDefaultFolder(olFolderInbox).Folders("Unwanted")
                MsgBox olkMsg.Subject, vbInformation + vbOKOnly, "Unwanted Message"
            Else
                MsgBox olkMsg.Subject, vbInformation + vbOKOnly, "Wanted Message"
            End If
        End If
    Next
    Set olkMsg = Nothing
End Sub

Open in new window



B - This is the Code that you have now (for sure you need to look under ThisOutlookSession Sub Application_NewMailEx
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
FilterIncomingMessages EntryIDCollection
End Sub

Open in new window



If what I showed above is correct then do the Following:


1) We need to comment out my code. So put a single Quote in fornt of FilterIncomingMessages EntryIDCollection
so it becomes:
'FilterIncomingMessages EntryIDCollection

2) Copy Paste the Entire Code that is Posted in Snipset A (EXCLUDING the first line and the last Line ie
WITHOUT
Private Sub Application_NewMailEx(ByVal
END SUB

and Just after my commented Instruction. so that the whole code becomes:

C - The final Code you should now have in this Sub
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
'FilterIncomingMessages EntryIDCollection
    Dim arrEID As Variant, varEid As Variant, olkMsg As Object
    arrEID = Split(EntryIDCollection, ",")
    For Each varEid In arrEID
        Set olkMsg = Session.GetItemFromID(varEid)
        If olkMsg.Class = olMail Then
            If UnwantedMessage(olkMsg) Then
                'On the next line change the name of the folder the unwanted messages will be move to.  That folder must be under the Inbox folder.
                olkMsg.Move Session.GetDefaultFolder(olFolderInbox).Folders("Unwanted")
                MsgBox olkMsg.Subject, vbInformation + vbOKOnly, "Unwanted Message"
            Else
                MsgBox olkMsg.Subject, vbInformation + vbOKOnly, "Wanted Message"
            End If
        End If
    Next
    Set olkMsg = Nothing
End Sub

Open in new window



SAVE YOUR OUTLOOK VBA
CLOSE OUTLOOK is asked to save say YES
Restart outlook and try to see if you are now where you first started with this question.

gowflow
Jose Rivera-Hernandez

ASKER
I am getting an error, see screenshots.

it's not working, could it be too many Keywords?

Here is what I have in "ThisOutlookSession", by the way I removed the pop up message I don't need that.

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
     'FilterIncomingMessages EntryIDCollection
     Dim arrEID As Variant, varEid As Variant, olkMsg As Object
    arrEID = Split(EntryIDCollection, ",")
    For Each varEid In arrEID
       Set olkMsg = Session.GetItemFromID(varEid)
        If olkMsg.Class = olMail Then
           If UnwantedMessage(olkMsg) Then
                'On the next line change the name of the folder the unwanted messages will be move to.  That folder must be under the Inbox folder.
                olkMsg.Move Session.GetDefaultFolder(olFolderInbox).Folders("Unwanted")
            End If
        End If
    Next
    Set olkMsg = Nothing
End Sub

Function UnwantedMessage(olkMsg As Outlook.MailItem) As Boolean
    'On the next line edit the keywords/phrases you want to filter out.  Use the | character to separate each word/phrase
    Const KEYWORDS = "ibpss@servicecu.org|CID|IPID_"
    Dim olkAtt As Outlook.Attachment, objRegEx As Object, colMatches As Object
    Set objRegEx = CreateObject("VBscript.RegExp")
    With objRegEx
        .IgnoreCase = False
        .Pattern = KEYWORDS
        .Global = True
    End With
    For Each olkAtt In olkMsg.Attachments
        If Not Prod_Support_Functions.IsHiddenAttachment(olkAtt) Then
            Set colMatches = objRegEx.Execute(olkAtt.FileName)
            If colMatches.Count > 0 Then
                UnwantedMessage = True
                Exit For
            End If
        End If
    Next
    Set olkAtt = Nothing
    Set objRegEx = Nothing
    Set colMatches = Nothing
End Function

Public Function IsHiddenAttachment(olkAtt As Outlook.Attachment) As Boolean
    ' Purpose: Determines if an attachment is a hidden attachment.
    ' Written: 7/12/2012
    ' Author:  David Lee
    ' Outlook: 2007 and later
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Dim olkPA As Outlook.PropertyAccessor, varTemp As Variant
    On Error Resume Next
    Set olkPA = olkAtt.PropertyAccessor
    varTemp = olkPA.GetProperty(PR_ATTACH_CONTENT_ID)
    IsHiddenAttachment = (varTemp <> "")
    On Error GoTo 0
    Set olkPA = Nothing
End Function

Open in new window


Here is what I have in "Module 1"

Sub FilterIncomingMessages(EntryIDCollection As String)
Dim oDeletedItems As Outlook.Folder
Dim oMyFolderReview As Outlook.Folder

Dim varEntryIDs, vTargetWords
Dim oMail As MailItem
Dim sMailPart As String, sFrom As String, sReceive As String
Dim I As Integer, J As Integer, K As Integer, pos As Integer
Dim bFound As Boolean

'---> Set variables
vTargetWords = Array("Acc Num", "Mem Num", "Mbr Num", "Lo Num", "Ch Num", "SSN", "Social Sec", "Driver Lic", "Photo ID", "Passport", "Network", "Password", "Passphrase", ".pdf", ".ppt", ".docx", ".xls", ".vsd", ".zip", ".accdb", ".accde", ".rtf", ".xml")
varEntryIDs = Split(EntryIDCollection, ",")
sFrom = "zixvpmgateway@servicecu.org"
sReceive = "infosecure@servicecu.org"

'---> Obtain a reference to specific deleted items folder
On Error Resume Next
Set oDeletedItems = Application.Session.GetDefaultFolder(olFolderInbox).Folders("ZixDelete")
If oDeletedItems Is Nothing Then
    Set oDeletedItems = Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add("ZixDelete")
End If
On Error GoTo 0

'---> Obtain a reference to Specific folder to move found items
On Error Resume Next
Set oMyFolderReview = Application.Session.GetDefaultFolder(olFolderInbox).Folders("Zix Emails")
If oMyFolderReview Is Nothing Then
    Set oMyFolderReview = Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add("Zix Emails")
End If
On Error GoTo 0

'---> Process
For I = 0 To UBound(varEntryIDs)
    
    'Set oMail = oitem
    Set oMail = Application.Session.GetItemFromID(varEntryIDs(I))
    'Debug.Print "NewMailEx " & oMail.Subject
    
    If sFrom = oMail.SenderEmailAddress And sReceive = oMail.To Then
    
        For K = 1 To 3
            Select Case K
                Case 1
                    sMailPart = LCase(oMail.Subject)
                Case 2
                    sMailPart = LCase(oMail.Body)
                Case 3
                    sMailPart = LCase(oMail.HTMLBody)
            
            
                For J = LBound(vTargetWords) To UBound(vTargetWords)
                    pos = InStr(1, sMailPart, LCase(vTargetWords(J)))
                    If pos <> 0 Then
                        bFound = True
                        Exit For
                    End If
                Next J
                If bFound Then Exit For
                
            End Select
        Next K
    
        '---> Check attachment only if not found
       ' If Not bFound Then
        '    If UnwantedMessage(oMail) Then
         '       bFound = True
          '  End If
       ' End If
        
        '---> Move Mail depending on result
        If Not bFound Then
            oMail.Move oDeletedItems
        Else
            oMail.Move oMyFolderReview
        End If
    End If
    
Next I

End Sub

Open in new window

Image-1.png
Image-2.png
gowflow

OK this is not my routine that is bugging. Do as the previous link said David Lee

Change

 "If Not Prod_Support_Functions.IsHiddenAttachment(olkAtt) Then"

 to

 ""If IsHiddenAttachment(olkAtt) Then"


Let me know.
gowflow
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
Jose Rivera-Hernandez

ASKER
now is on the next line of code....
Image-13.png
gowflow

What is the error please ?? again not my macro !!!
gowflow
Jose Rivera-Hernandez

ASKER
Ok so I am not longer getting the emails I need to review as attachments, now they are being forwarded so it will be easier to search for the keywords.  I am very thankful that you have helped me with this, so I understand if you no longer wants to help me since once again things have changed on my end.

I still want to give you credit for your suggestions.

thanks,
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
gowflow

I never said I didn't want to help you ! why you assume this. I have done the maximum to help you. If things have changed your end well I can't do much.

As Bill Prew said you will need to make your decision as to this question fate.

Please feel free to let me know if you need more help.
gowflow
Jose Rivera-Hernandez

ASKER
Thank you gowflow
gowflow

Thank you. Let me know if you need help on other issues.
gowflow
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.