Outlook events stop work randomly

[Pioytabu]

I had the next vba program in outlook seesion. This works fine but stop works random and the event not fired when outlook not is closed for a days.

Can help me please?

This is my code


Option Explicit
Private WithEvents inboxItems As Outlook.Items

Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace

Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler

Dim Msg As Outlook.MailItem
Dim MessageInfo
Dim Result
If TypeName(Item) = "MailItem" Then
MessageInfo = "" & _
"Sender : " & Item.SenderEmailAddress & vbCrLf & _
"Sent : " & Item.SentOn & vbCrLf & _
"Received : " & Item.ReceivedTime & vbCrLf & _
"Subject : " & Item.Subject & vbCrLf & _
"Size : " & Item.Size & vbCrLf & _
"Message Body : " & vbCrLf & Item.Body
Result = MsgBox(MessageInfo, vbOKOnly, "New Message Received")
End If

ExitNewItem:
Exit Sub

ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ExitNewItem
End Sub