VBA MailItem.Add only triggering once?

Question

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!

You are using objects without declaring them (or at least without showing how they are declared). Here the only declared object is `objWathchFolder`, but we don't have declarations for `objNS` nor `objItem`. Note that if they are not declared as global, they only have a locale declaration range (and are destroyed at the end of `Application_Startup` — Vincent G, Oct 15 '18 at 09:14
Apologies, with you now: Private objNS as Outlook.NameSpace Private WithEvents objItems as Outlook.Items — TKCZBW, Oct 15 '18 at 09:19
Please [edit](https://stackoverflow.com/posts/52812765/edit) your question to add the declarations — Vincent G, Oct 15 '18 at 09:26

score 0 · Accepted Answer · answered Oct 16 '18 at 15:28

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?

VBA MailItem.Add only triggering once?

1 Answers1