I am looking to call a set of functions when I receive email to different mailboxes (if a mail arrives to abc#outlook.com perform function1, if a mail arrives to def#outlook.com perform function2)
I have the code below for one mailbox but I am unsure how to expand it to also listen on another mailbox without conflicting. How can I setup listeners for multiple mailboxes?
Any help appreciated. Thank you
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
'do Stuff to mailitem
End Sub
Just add another WithEvent to watch the other folder:
Private WithEvents Items As Outlook.Items
Private WithEvents Items1 As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
Set Items1 = objNS.Folders.Item("def#outlook.com").Folders.Item("Inbox").Folders.Item("ASubFolder").Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
'do Stuff to mailitem
End Sub
Private Sub Items1_ItemAdd(ByVal Item As Object)
'do stuff.
End Sub
Related
I have code in ThisOutlookSession to do something with items I send. It checks the Sent Items folder. It works only for one specified mailbox/folder.
I would like to monitor three mailboxes
I can change the line:
Set Items = AInbox.Items
and it will work, but only for the mailbox I set it to.
Private Sub Application_Startup()
Dim olNs As Outlook.NameSpace
Dim AInbox As Outlook.MAPIFolder
Dim BInbox As Outlook.MAPIFolder
Dim CInbox As Outlook.MAPIFolder
Dim AItems As Items
Dim BItems As Items
Dim CItems As Items
Set olNs = Application.GetNamespace("MAPI")
Set AInbox = GetFolder("a#email.co.ukInbox\Sent Items")
Set BInbox = GetFolder("b#email.com\Inbox\Sent Items")
Set CInbox = GetFolder("c#email.com\Inbox\Sent Items")
Set Items = AInbox.Items
End Sub
Public Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
'Do something
End If
End Sub
You may monitor any number of folders.
Private WithEvents AItems As Items
Private WithEvents BItems As Items
Private WithEvents CItems As Items
then
Set AItems = AInbox.Items
Set BItems = BInbox.Items
Set CItems = BInbox.Items
then
Public Sub AItems_ItemAdd(ByVal Item As Object)
Public Sub BItems_ItemAdd(ByVal Item As Object)
Public Sub CItems_ItemAdd(ByVal Item As Object)
I have two sets of code. The first code adds a preset BCC address triggered by a button. The second code enables filing of emails, by tagging/categorizing the sent email, copying that sent email and then moving the copy to the folder indicated in pickfolder.
The two codes work separately.
When I paste both codes in ThisOutlookSession, the second one does not work. The error is (loosely translated from Dutch): "compilation error: invalid characteristics in Sub or Function" which relates to all three declarations (Dim WithEvents objInspectors As Inspectors, Dim WithEvents objMyNewMail As MailItem, Dim WithEvents colSentItems As Items)
The full codes:
'button bcc to crm system emailaddress)
Sub AddCRMtoBCC()
Dim objRecip As Recipient
Set oMsg = Application.ActiveInspector.CurrentItem
With oMsg
Set objRecip = oMsg.Recipients.Add("__#__.com")
objRecip.Type = olBCC
objRecip.Resolve
End With
Set oMsg = Nothing
End Sub
'________
'file emails
Dim WithEvents objInspectors As Inspectors
Dim WithEvents objMyNewMail As MailItem
Dim WithEvents colSentItems As Items
Private Sub Application_Startup()
Set objInspectors = Application.Inspectors
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
Set colSentItems = NS.GetDefaultFolder(olFolderSentMail).Items
Set NS = Nothing
End Sub
Private Sub Application_Quit()
Set objInspectors = Nothing
Set objMyNewMail = Nothing
End Sub
Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
If Inspector.CurrentItem.Class <> olMail Then Exit Sub
Set objMyNewMail = Inspector.CurrentItem
End Sub
Private Sub objMyNewMail_Send(Cancel As Boolean)
If MsgBox("Are you sure you want to send this message?", vbYesNo + vbQuestion _
, "SEND CONFIRMATION") = vbNo Then
Cancel = True
End If
End Sub
Private Sub colSentItems_ItemAdd(ByVal Item As Object)
If Item.Class = olMail Then
Set Copy = Item.Copy
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
Copy.Move objFolder
End If
End Sub
When you declare global variables at module level (ThisOutlookSession is a module), all of them should be declared at the top of the module.
thus, move those 3 lines at the top , before the very first sub()
Dim WithEvents objInspectors As Inspectors
Dim WithEvents objMyNewMail As MailItem
Dim WithEvents colSentItems As Items
objMyNewMail_Send() Cancel parameter must be declared ByRef
I have this code in a module:
Private WithEvents objNewMailItems As Outlook.Items
Public Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set mainInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub mainInboxItems_ItemAdd(ByVal item As Object)
Call MandarMail.sendOutlookEmail
' //this send another email...
End Sub
This is my first time using a trigger. Visual Basic for Applications does not recognize this:
Private WithEvents objNewMailItems As Outlook.Items
I'm using Outlook 2013
If written in Outlook this should work.
You've declared objNewMailItems but used mainInboxItems
Dim WithEvents objNewMailItems As Items
Public Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = olApp.GetNamespace("MAPI")
Set objNewMailItems = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub objNewMailItems_ItemAdd(ByVal item As Object)
'This will fire when you receive a new email.
Debug.Assert False
End Sub
Edit - I've found with this that after a while Outlook disables the macros, so have to manually run StartUp each day. Doesn't matter what I try with the Trust Centre settings - it keeps disabling my code.
Thx Darren. I modificated your code and now works fine:
Dim WithEvents objNewMailItems As Items
Public Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Dim olApp As Outlook.Application
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set objNewMailItems = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub objNewMailItems_ItemAdd(ByVal item As Object)
'This will fire when you receive a new email.
MsgBox ("mail recibi")
End Sub
How do I show a MsgBox or alert upon receiving a message with a specified subject or sender?
I put this procedure in ThisOutlookSession block.
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim myMail As MailItem
Dim name As String
If TypeOf Item Is MailItem Then
Set myMail = Item
If myMail.Subject Like "*Hello world*" And myMail.Categories = "" Then
MsgBox "Message", vbInformation, "approved"
MailDate = myMail.ReceivedTime
myMail.Categories = "CZEART"
myMail.MarkAsTask (olMarkNoDate)
myMail.Save
End If
End If
End Sub
To test the code, open a mailitem with the required conditions then step through this.
Option Explicit
Private Sub test()
Dim currItem As MailItem
Set currItem = ActiveInspector.currentItem
olInboxItems_ItemAdd currItem
End Sub
Likely though you need this in the ThisOutlookSession module.
Option Explicit
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
' instantiate objects declared WithEvents
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
http://www.outlookcode.com/article.aspx?id=62
I'm receiving Error 429 'Active X Component Can't create the object' when I start Outlook 2013. While debugging I found it was occurring at Set oOutlook = New Outlook.Application. But when I run the code after Outlook is started it works fine. Any idea why this is occurring?
Option Explicit
Private WithEvents oOutlook As Outlook.Application
Private WithEvents oMailItems As Outlook.Items
Private ns As NameSpace
Private Inbox As MAPIFolder
Private InboxItems As Outlook.Items
Private FailNotice As MAPIFolder
Private zsForwardTo As String
Private Sub Class_Initialize()
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set InboxItems = Inbox.Items
Set oOutlook = New Outlook.Application
Set oMailItems = oOutlook.Session.GetDefaultFolder(olFolderInbox).Items
Set FailNotice = Inbox.Folders("Fail Notices")
End Sub
Based on Max's comment, I wanted to post an answer because this was really helpful and I couldn't find this anywhere else on the web. Max wrote:
I had a simular problem, I think Outlook is having a problem wirh creating a new instance while it is not fully started itself. In the end i did not create a new application but worked in the existing one.
I wasn't sure how to use the existing application, but I got it working like this: the oOutlook variable is now unnecessary and can be replaced by the simple word "Application". The revised code would look like this:
Option Explicit
Private WithEvents oMailItems As Outlook.Items
Private ns As NameSpace
Private Inbox As MAPIFolder
Private InboxItems As Outlook.Items
Private FailNotice As MAPIFolder
Private zsForwardTo As String
Private Sub Class_Initialize()
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set InboxItems = Inbox.Items
Set oMailItems = Application.Session.GetDefaultFolder(olFolderInbox).Items
Set FailNotice = Inbox.Folders("Fail Notices")
End Sub