I have written a brief piece of code to perform certain actions when an e-mail arrives in the mailbox, but it only seems to work for the first e-mail that arrives immediately after the code is saved, after that nothing happens for subsequent e-mails.
I have put a watch on the code, and nothing is triggered, so it is not just a subsequent error in the subsequent code.
Code is (in the session object):
Option Explicit
Private objNS As Outlook.Namespace
Private WithEvents objItems As Outlook.Items
Private sub Application_Startup()
Dim objWatchFolder as Outlook.Folder
Set objNS = Application.Getnamespace("MAPI")
Set objWatchFolder = objNS.GetDefaultFolder(olFolderInbox)
Set objItems = objWatchFolder.Items
End Sub
Private Sub objItems_ItemAdd(ByVal Item as Object)
' Do this, that, the other, passing the e-mail to other subroutines
' No problems in this code.
End Sub
Any guidance or pointers that can be given would be greatly appreciated!
Please restart your Outlook if you use the WithEvents. However, please try to the following code:
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)
On Error Goto ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
' do something here
' ******************
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Reference link:How do I trigger a macro to run after a new mail is received in Outlook?
Related
I'm trying to modify incoming emails in a specific folder and send it to another person.
The part modify/send works.
The script doesn't work when there is new email. It only works when I transfer it to myself.
The beginning of the code:
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).Folders("DI").Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
Did you restart your Outlook? Please refer to the following code:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Set olApp = Outlook.Application
Set Items = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("Stuff").Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
MsgBox "You moved an item into the 'Stuff' folder."
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
Set GetNS = app.GetNamespace("MAPI")
End Function
Here is a link: VBA Outlook event moving email
I made a code that would take an incomming email in a specific folder (First a rule is created in order to move the mail to the folder and then the script is launched).
The problem is that the rule is working (it moves the mail to the folder), but the script isn't.
The thing is that when I take the new mail and transfer it to myself (My email is also in the receivers in the rules), the script is correctly working.
Here is the beginning of the code that I believe may be wrong.
Sub Script(item As Outlook.MailItem)
Dim strMailID As String
Dim objMail As Outlook.MailItem
Dim objNamespace As Outlook.NameSpace
strMailID = item.EntryID
Set objNamespace = Application.GetNamespace("MAPI")
Set objMail = objNamespace.GetItemFromID(strMailID)
Dim objpf As MAPIFolder
If objMail.MessageClass = "IPM.Note" Then
Any help would be appreciated
You need add an event listener to the default local Inbox, it worked with Outlook 2016.
This code will add an event listener to the default local Inbox. Action will be placed upon incoming emails. You need to add actions you need in the code below:
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)
On Error Goto ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
' do something here
' ******************
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
After pasting the code in ThisOutlookSession module, you must restart Outlook.
Private WithEvents Items As Outlook.Items
Public MyTrueFalse As Boolean
Private Sub Application_Startup()
Dim MyTrueFalse As Boolean 'Redundant?'
MyTrueFalse = True 'Defaults to False'
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, ByVal MyTrueFalse As Boolean)
If MyTrueFalse Then GoTo DoThisAlso 'Example Only'
On Error Goto ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
' do something here
' ******************
End If
DoThisAlso:
MsgBox "MyTrueFalse is: " & MyTrueFalse
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
I am using the code above and its working wonderfully on the NEW EMAIL trigger (THANK YOU - Gautam Mainkar (LINK). However, I am trying to pass a Boolean (True/False) variable along with the Items event trigger.
So I am attempting to set say...MyTrueFalse within the Application_Startup() so it is set ONLY ONCE, and passed whenever Items_ItemAdd is triggered by a new email.
I do not want another sub routine, just pass MyTrueFalse boolean as set in the Application_Startup().
I have tried multiple variations of Public settings and multiple variables on the Items_ItemAdd sub and nothing works. I am hoping someone can help me here. Thanks
Oh Yeah: it resides in ThisOutlookSession
Private WithEvents Items As Outlook.Items
Private MyTrueFalse As Boolean
Private Sub Application_Startup()
MyTrueFalse = True
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)
If MyTrueFalse Then GoTo DoThisAlso 'Example Only'
On Error Goto ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
' do something here
' ******************
End If
DoThisAlso:
MsgBox "MyTrueFalse is: " & MyTrueFalse
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Tim Williams was right, corrected the code (above) and works great!! Thanks Tim. Mike
I am watching for new items and then calling a subroutine. In place of the subroutine, I am currently using a message box for testing.
Initially the code worked properly. After running it a few times, it quit working. If I shut down Outlook and reopened it would work again a few more times. I searched many sites for answers.
I tried backing up the project file, deleting it, restoring it. I was able to use this code again for awhile. Now I can't get it to work, regardless of what I do. I have been working on this for two days, but I cannot understand what is going wrong. I'm running Outlook 2010 and my code is posted below.
The code is saved in This Outlook Session:
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).Folders("Access Data Collection Replies").Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
' This is going to be the code to respond to the dealer and to call procedures. Maybe it can be handled with case statements. Then each event can be identified.
' ******************
MsgBox("It Worked!")
Call AnswerD
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
your code works find, if you are trying to get the msg box to pop then
Move this line code
MsgBox ("It Worked!")
next to
If TypeName(item) = "MailItem" Then
MsgBox ("It Worked!")
here is complete code tested on Outlook 2010
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olNameSpace As Outlook.NameSpace
Set olNameSpace = Application.GetNamespace("MAPI")
'// ' Default local Inbox (olFolderInbox) & sub ("Folder Name")
Set Items = olNameSpace.GetDefaultFolder(olFolderInbox).Folders("Access Data Collection Replies").Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
If TypeOf item Is Outlook.MailItem Then
MsgBox ("It Worked!")
'AnswerD '<-- un-comment to call subroutine.
End If
End Sub
Private Sub SaveMovePrint(OlMail As Outlook.MailItem)
'On Error GoTo ErrorHandler
' ******************
' Here subroutine
' ******************
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
I have the following code which tells when new message has arrived!
Private Sub Application_NewMail()
MsgBox "New Mail Has Arrived"
End Sub
How do I read the body,subject of this mail? Are there any good tutorials for outlook programming?
I found msdn tutorial which was useful but was general overview.
You'll need something like this:
Private WithEvents myOlItems 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")
Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
MsgBox Msg.Subject
MsgBox Msg.Body
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Paste the code into ThisOutlookSession and restart Outlook. When a message enters your default local Inbox you'll see the popup with subject and body.