I am working for the VBA Macros of Outlook 2010 to filter and categorize incoming emails into different folders. The rule is mentioned in the target
When it comes to the implementation and testing, it does prompting error messages boxes instead of successful filtering. Would you please tell me what section under default call Application_NewMail shall proceed ?
Target :
extract words within [this Bracket]
Subject : [ABC] --> create inbox folder ABC
Subject : [CMX] --> create inbox folder ABC
Subject : CMX --> create inbox folder CMX
Subject : INC000000156156 --> create inbox folder INC and sub-folder INC000000156156
Programming Language : VBA Macro
Outlook Version : 2010
Here is my code and I have no clue on how to create folders if empty and assign email to the folder :
Private Sub Application_NewMail()
Dim olFld As Outlook.MAPIFolder
Set olFld = Outlook.Session.GetDefaultFolder(olFolderInbox)
olFld.Items.Sort "[ReceivedTime]", False
Dim olMail As Outlook.MailItem
Set olMail = olFld.Items.GetFirst
MyNiftyFilter olMail
End Sub
Private Sub MyNiftyFilter(Item As Outlook.MailItem)
Debug.Print Item
Debug.Print Item.Subject
Dim Matches As Variant
Dim RegExp As New VBScript_RegExp_55.RegExp
Dim Pattern As String
Dim Email_Subject As String
Pattern = "(([\w-\s]*)\s*)"
Email_Subject = Item.Subject
With RegExp
.Global = False
.Pattern = Pattern
.IgnoreCase = True
Set Matches = .Execute(Email_Subject)
End With
If Matches.Count > 0 Then
End If
Set RegExp = Nothing
Set Matches = Nothing
Set Item = Nothing
End Sub
You either use ItemAdd event https://stackoverflow.com/a/58428753/4539709 or fix your NewMail to simply
Private Sub Application_NewMail()
Dim Item As Outlook.MailItem
MyNiftyFilter Item
End Sub
The NewMail event fires when new messages arrive in the Inbox and before client rule processing occurs. If you want to process items that arrive in the Inbox, consider using the ItemAdd event on the collection of items in the Inbox. The ItemAdd event passes a reference to each item that is added to a folder.
You Application_NewMail() sub declares but never initializes the Item variable. Use NewMailEx event instead -it passes the new message entry id, whcih you can use to call Application.Session.GetItemFromID.
Related
Every day I get one or more spam emails of a very specific type to my xxxxx#gmail account.
They all have a garbled and unique FROM: email address.
The TO: and CC: fields are always of the form xxxxx[random chars]#aol.com. For example I got one today with
TO: xxxxx#aol.com
CC: xxxxxY7#aol.com
I would like to create a rule to automatically send these to spam and block. Two possible conditionals would be:
"with xxxxx AND #aol.com in recipient's address"
"with xxxxx*#aol.com in recipient's address" (with * as a wildcard).
#1 doesnt work because the "specific words" it requests are concatenated with OR, no option to use AND.
#2 doesn't work because as far as I can tell there is no way to use wildcards.
Any suggestions? I realize there probably is a straightforward VBA script solution but I haven't played with VBA in over a decade. Was hoping there might be another clever non-VBA work around. Thanks.
There is no workaround. You can handle incoming emails in Outlook VBA by handling the NewMailEx event of the Application class. This event fires once for every received item that is processed by Microsoft Outlook. The item can be one of several different item types, for example, MailItem, MeetingItem, or SharingItem. The EntryIDsCollection string contains the Entry ID that corresponds to that item. You can use the Entry ID from the EntryIDCollection parameter to call the NameSpace.GetItemFromID method and process the item.
In the NewMailEx event handler you can check the required properties such as Recipients and etc. and move the item wherever you need.
As stated, NewMailEx can be used to handle some filtering like this and I have a regex filter that I use as standard automatic rules don't allow that (or at least not currently - maybe a future upgrade). If you can use a regex to identify the e-mails you want to process then you could use this code:
In ThisOutlookSession
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
On Error Resume Next
Call RegExFilterRules(EntryIDCollection)
End Sub
In a module
Sub RegExFilterRules(ItemID As String)
With Application.GetNamespace("MAPI")
Dim Inbox As Outlook.MAPIFolder: Set Inbox = .GetDefaultFolder(olFolderInbox)
Dim Junk As Outlook.MAPIFolder: Set Junk = .GetDefaultFolder(olFolderJunk)
Dim olItem As Outlook.MailItem: Set olItem = .GetItemFromID(ItemID, Inbox.StoreID)
End With
'On Error Resume Next
If Not olItem Is Nothing And olItem.Class = olMail Then
If IsPatternFound(olItem.subject, "^M\d+$") Then olItem.Move Junk 'olItem.Delete 'olItem.UnRead = False
If olItem.Sender = "cortana#microsoft.com" Then olItem.Delete
End If
Set olItem = Nothing
End Sub
Private Function IsPatternFound(Content As String, Pattern As String) As Boolean
' Requires Reference: Microsoft Scripting Runtime
Dim RegEx As Object: Set RegEx = CreateObject("vbscript.RegExp")
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = Pattern
IsPatternFound = .Test(Content)
End With
End Function
It is possible to create a rule which, for a sender, moves all the mails to the folder of your choice (for example, it creates a folder with the name of the sender).
If I want that for all the expeditors, I need to repeat the rule creation for each sender.
What I'd wish would be a macro "meta-rule" for each sender to have a folder with their name with the corresponding mails sorted.
I tried to start from the topic Outlook template rule to sort mails among directories.
I wrote this:
Sub RulesForFolders(m As MailItem)
Dim fldr As Outlook.Folder
For Each fldr In GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders
if fldr.Name Like m.SenderName Then m.MoveTo(SenderName)
else folders.add(m.SenderName)
Next
Set fldr = Nothing
End Sub
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
'
' If desperate declare as variant
Private Sub RulesForFolders(m As mailItem)
Dim targetFldr As folder
Dim myRoot As folder
Dim i As Long
Set myRoot = Session.GetDefaultFolder(olFolderInbox)
Debug.Print m.senderName
' This is often misused.
On Error Resume Next
' If folder exists the error is bypassed
' This is a rare beneficial use of On Error Resume Next
myRoot.folders.Add m.senderName
' Consider it mandatory to return to normal error handling
On Error GoTo 0
Set targetFldr = myRoot.folders(m.senderName)
m.Move targetFldr
End Sub
Private Sub RulesForFolders_test()
' Code requiring a parameter cannot run independently
Dim selItem As Object
' first select a mailitem
Set selItem = ActiveExplorer.Selection(1)
If selItem.Class = olMail Then
RulesForFolders ActiveExplorer.Selection(1)
End If
End Sub
First of all, I'd suggest starting from the NewMailEx event of the Application class which is fired when a new item is received in the Inbox. This event fires once for every received item that is processed by Microsoft Outlook. The item can be one of several different item types, for example, MailItem, MeetingItem, or SharingItem. The EntryIDsCollection string contains the Entry ID that corresponds to that item. The NewMailEx event fires when a new message arrives in the Inbox and before client rule processing occurs. You can use the Entry ID returned in the EntryIDCollection array to call the NameSpace.GetItemFromID method and process the item.
To find the folder with a sender name you can iterate over all subfolders recursively:
Private Sub processFolder(ByVal oParent As Outlook.MAPIFolder)
Dim oFolder As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem
For Each oMail In oParent.Items
'Get your data here ...
Next
If (oParent.Folders.Count > 0) Then
For Each oFolder In oParent.Folders
processFolder oFolder
Next
End If
End Sub
Finally, I'd recommend delving deeper with VBA by starting from the Getting started with VBA in Office article.
You can also use the following code if you don't need to iterate over all folders:
Sub RulesForFolders(m As MailItem)
Dim fldr As Outlook.Folder
Dim new_fldr As Outlook.Folder
Dim ns as Outlook.Namespace
Dim inbox as Outlook.Folder
Set ns = Application.GetNamespace("MAPI")
Set inbox = ns.GetDefaultFolder(olFolderInbox)
For Each fldr In inbox.Folders
if InStr(fldr.Name,m.SenderName) > 0 Then
m.MoveTo(fldr)
Return
End If
Next
Set new_fldr = folders.add(m.SenderName)
m.MoveTo(new_fldr)
Set fldr = Nothing
Set new_fldr = Nothing
Set inbox = Nothing
Set ns = Nothing
End Sub
I want to set an auto-category for the incoming email in Outlook 2010 but my code does not work.
I restarted Outlook many times.
Public WithEvents olItems As Outlook.Items
Private Sub Application_Startup()
Set objItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub objItems_ItemAdd(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim strSenderEmailAddress As String
Dim objContacts As Outlook.Items
Dim objContact As Object
Dim objFoundContact As Outlook.ContactItem
Dim strFilter As String
Dim strContactCategory As String
Dim i As Long
If TypeOf Item Is MailItem Then
Set objMail = Item
strSenderEmailAddress = objMail.SenderEmailAddress
Set objContacts =
Outlook.Application.Session.GetDefaultFolder(olFolderContacts).Items
For Each objContact In objContacts
If TypeOf objContact Is ContactItem Then
For i = 1 To 3
strFilter = "[Email" & i & "Address] = " &
strSenderEmailAddress
Set objFoundContact = objContacts.Find(strFilter)
'Check if the sender exists in your contacts folder
If Not (objFoundContact Is Nothing) Then
strContactCategory = objFoundContact.Categories
'If the corresponding contact has no category
'Assign the "Known" category to the email
If strContactCategory = "" Then
objMail.Categories = "Known"
'If the contact has, directly use its category
Else
objMail.Categories = strContactCategory
End If
Exit For
End If
Next i
'If the sender doesn't exist in the Contacts folder
'Assign the "Unknown" category to the email
If objFoundContact Is Nothing Then
objMail.Categories = "Unknown"
End If
End If
Next objContact
End If
End Sub
I am not good in VBA. When new email arrives my mailbox, it is not auto-categorized, no color filling in Category field in Outlook, nothing happens.
I want to set auto-category for the incoming email in outlook 2010 but my code does not work.
First of all, you need to handle the NewMailEx event of the Application class which is fired when a new item is received in the Inbox.
The NewMailEx event fires when a new message arrives in the Inbox and before client rule processing occurs. You can use the Entry ID returned in the EntryIDCollection array to call the NameSpace.GetItemFromID method and process the item. Use this method with caution to minimize the impact on Outlook performance. However, depending on the setup on the client computer, after a new message arrives in the Inbox, processes like spam filtering and client rules that move the new message from the Inbox to another folder can occur asynchronously.
After getting the item received you may set a category.
P.S. The ItemAdd event may not be fired at all if you receive more than sixteen items simultaneously. This is a known issue in the Outlook object model.
I receive mails, from two senders, with two subjects, to a specific address.
I set up a rule:
from: example#example.com or example2#example2.com
sent to: me#me.com
and with: Company return doc or Daily document Country in the subject
except if the subject contains "FW:"
to run a script:
Sub myRuleMacro(Item As Outlook.MailItem)
Dim selEmail As Outlook.MailItem
Set selEmail = ActiveExplorer.Selection.Item(1).Forward
selEmail.Recipients.Add "address#address.pl"
selEmail.Send
Set selEmail = Nothing
End Sub
The script works for the selected email but to select it I need to click it manually, or if any other email is already clicked/marked it forwards this marked email, not the one from the rule.
How to choose the mail from the rule to trigger the macro?
Basically I need the solution which will forward the email. I cannot use the forwarding rule due to company safety policies.
You all most got it, it should be
Example
Option Explicit
Public Sub myRuleMacro(Item As Outlook.MailItem)
Dim selEmail As Outlook.MailItem
If TypeOf Item Is Outlook.MailItem Then
Set selEmail = Item.Forward
selEmail.Subject = Item.Subject
selEmail.HTMLBody = Item.HTMLBody
selEmail.Recipients.Add "address#address.pl"
selEmail.Save
selEmail.Send
End If
End Sub
No need for Selection.Item and make sure to save it before sending it
The email that the rule is triggered on is already being passed to the sub Item as Outlook.MailItem -- Sub myRuleMacro(**Item As Outlook.MailItem**)
You're not using this provided item and selecting a DIFFERENT item when you use Set selEmail = ActiveExplorer.Selection.Item(1).Forward
You should be able to simply use Item.Forward
Try
Sub myRuleMacro(Item As Outlook.MailItem)
Dim newForward as MailItem
Set newForward = Item.Forward
newForward.Recipients.Add "address#address.pl"
newForward.Send
End Sub
EDITED: To include updates by #Tony Dallimore in comments.
Error: Object not Found.
MyEmailAddress has a folder called CL and when there is something there, I want a macro called "InsertData" to run.
Dim E_flge As Byte
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim NS As Outlook.NameSpace
Dim MyMail As Object
Set NS = Application.GetNamespace("MAPI")
Set MyMail = NS.GetItemFromID(EntryIDCollection)
E_flge = 0
If MyMail.Class = olMail Then
If MyMail.Parent.Parent = "MyEmailAddress" Then
InsertData 'Macro I am trying to call
End If
End If
End Sub
I pretty sure you need to have a actually "Call" the macro
Call InsertData
The object not found may be in the macro itself. Perhaps you should post that
"The NewMailEx event fires when a new message arrives in the Inbox..." https://msdn.microsoft.com/en-us/library/office/ff863686.aspx"
This is the default Inbox. You likely want to reference a non-default Inbox so you cannot use NewMailEx.
Try ItemAdd along with Get reference to additional Inbox