Mover itens para uma subpasta especificada dentro do Outlook com base em ReceivedTime

Estou tentando mover itens do Outlook. No entanto, o código é executado sem mensagens de erro, mas nenhum email é movido.

Isso me leva a crer que o necessárioIF condition nunca está sendo cumprido? No entanto, eu posso estar errado.

Por favor, encontre o código abaixo.

Sub Gatekeeper()
    Dim aItem As Object
    Dim mail As Object
    Dim strTime As String
    Dim Items As Outlook.Items
    Dim olNs As Outlook.NameSpace
    Dim subfolder As Outlook.MAPIFolder

    Set olNs = Application.GetNamespace("MAPI")
    Set mail = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = mail.Items

    For Each aItem In Items
        strTime = aItem.ReceivedTime

        If strTime > #6:00:00 PM# And strTime < #5:30:00 AM# Then
            Set subfolder = mail.Folders("Nights")
            aItem.Move subfolder
        End If

    Next aItem
End Sub

questionAnswers(2)

yourAnswerToTheQuestion