Outlook code not running now and again?

[Welshgasman]

Hi all,

I found some code on the net and modified it for my needs.
For the most part, it works fine. However some times the code does not run, until I close Outlook and open it up again. I shut down my computer each evening.

I am looking for any tips that would explain why it might stop working.?
The code is located in ThisOutlookSession module



TIA

Option Explicit
Public WithEvents myOlApp As Outlook.Application
Private Sub Application_Startup()
    Initialize_handler
End Sub
Public Sub Initialize_handler()
    Set myOlApp = Outlook.Application
End Sub

Private Sub myOlApp_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim strGreeting As String
    Dim iTime As Integer
    Dim strBody As String, strDivCode As String
    strGreeting = ""
    strDivCode = "<div class=WordSection1><p class=MsoNormal>"
    iTime = Val(Format(Now(), "hh"))
  
    ' Quit if not a mail item
    If TypeName(Item) <> "MailItem" Then
        Exit Sub
    End If
    
    Select Case iTime
    Case Is < 12
        strGreeting = "morning "
    Case Is < 17
        strGreeting = "afternoon "
    Case Else
        strGreeting = "evening "
    End Select

    strGreeting = "Good " & strGreeting

    
    strBody = Item.HTMLBody
    strBody = Replace(strBody, "Good day", strGreeting)
    'strBody = Replace(strBody, strDivCode, strDivCode & strGreeting)
  
    Item.HTMLBody = strBody
End Sub