Forwarding email based on time email was received

Question

I found a single reference on using VBA to forward emails based on the time of day they were received.

I have a client looking to forward their emails to an after hours service between X and Y times. I followed a few guides on syntax and operations.

Private WithEvents objInboxItems As Outlook.Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
' instantiate Items collections for folders we want to monitor
Set objInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing

Debug.Print "Application_Startup occurred " & Now()

End Sub

Private Sub Application_Quit()
' disassociate global objects declared WithEvents
Set objInboxItems = Nothing
End Sub

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim olItems As Items, _
olItem As Object, _
olMailItem As MailItem, _
olAttachmentItem As Attachment, _
bolTimeMatch As Boolean
Set olItems = objInboxItems.Restrict("[Unread] = True")
For Each olItem In olItems
    If olItem.Class = olMail Then
        Set olMailItem = olItem
        'Change the times on the next line to those you want to use
        bolTimeMatch = (Time >= #3:00:00 PM#) And (Time <= #8:30:00 AM#)
        If bolTimeMatch Then
            Dim objMail As Outlook.MailItem
            Set objItem = olMailItem
            Set objMail = objItem.Forward
            'PUT THE EXTERNAL EMAIL ADDRESS YOU WANT TO USE ON THE NEXT LINE
            objMail.To = "[email protected]"
            objMail.Send
            Set objItem = Nothing
            Set objMail = Nothing
        End If
    End If
Next
End Sub

Function IsNothing(Obj)
If TypeName(Obj) = "Nothing" Then
    IsNothing = True
Else
    IsNothing = False
End If
End Function

I added a debug print to see that the macro is starting, and I get positive output, but no emails are actually triggering the forward.

This use case is needed because the emails are being forwarded to a transcription service, so a fire and forget solution is desired over manually setting the forward every day.

Answer 1

I believe the condition will always be False. Break into parts. It is easier to debug.

To process an incoming item apply code to the Item in Private Sub objInboxItems_ItemAdd(ByVal Item As Object).

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)

    Dim bolTimeMatch As Boolean
    Dim objMail As mailItem
    
    If Item.Class = olMail Then
        
        bolTimeMatch = (Time >= #3:00:00 PM#)
        
        If bolTimeMatch Then
            
            Set objMail = Item.Forward
            
            objMail.To = "[email protected]"
            objMail.Display    ' objMail.send
                    
        Else
        
            bolTimeMatch = (Time <= #8:30:00 AM#)
            
            If bolTimeMatch Then
            
                Set objMail = Item.Forward
                    
                objMail.To = "[email protected]"
                objMail.Display    ' objMail.send
            End If
                
        End If
        
    End If

End Sub