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

[gmayor]

If it works when you restart Outlook, it is almost certainly losing the startup event, which in any case shouldn't be necessary. Change the code to

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)
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim strGreeting As String
    'etc

and there is no event handler to lose.

[Welshgasman]

Thank you Graham,

I'll give that a go and report back.

[Welshgasman]

Hi Graham,
Well I've given it a test for a few weeks and all has worked as I wanted.

Thank you for your help.

[Welshgasman]

Thought I had posted this the other day?

It is not working again after some time. Cannot pin down exactly when it happens. I just notice a sent email has not changed the greeting.
I close Outlook and start again and it works.?

Any possible ideas to the cause please.?

TIA

[gmayor]

I have been away for a couple of weeks so am just catching up on older stuff.
Did you change any code in Outlook VBA as that could stop it working. If it stops either restart Outlook or re-run the macro - Initialize_handler

[Welshgasman]

Hi Graham,
Thank you for the reply.

There is no Initialize_handler any more, that was removed/replaced as you said it was not necessary.?

Code is now as below and in module ThisOutlookSession, where it has always been located. The other day it stopped working almost immediately.

If I restart Outlook it then works again (for a short while at least) which was the same effect when using the Initialize_handler method.

Private Sub Application_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