Option Explicit

Sub Test()
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    FlagMessage olMsg
lbl_Exit:
    Exit Sub
End Sub

Sub FlagMessage(olItem As MailItem)
Dim strName As String
Dim strSubject As String
Dim strTime As String
Dim vItem As Variant
Dim vText As Variant
Dim vSubject As Variant
Dim i As Long
Dim olFolder As Folder
Dim olItems As Items
Dim olMsg As MailItem
    With olItem
        If LCase(.Subject) = "for examination" Then
            vText = Split(olItem.Body, Chr(13))
            For i = 0 To UBound(vText)
                If InStr(1, vText(i), "From: ") > 0 Then
                    vItem = Split(vText(i), Chr(58))
                    strName = LCase(Trim(vItem(1)))
                    strName = Replace(strName, " [mailto", "")
                    Exit For
                End If
            Next i
            For i = 0 To UBound(vText)
                If InStr(1, vText(i), "Sent: ") > 0 Then
                    vItem = Split(vText(i), Chr(58))
                    strTime = Trim(vItem(1)) & Chr(58) & vItem(2)
                    Exit For
                End If
            Next i
            For i = 0 To UBound(vText)
                If InStr(1, vText(i), "Subject: ") > 0 Then
                    vItem = Split(vText(i), Chr(58))
                    strSubject = LCase(Trim(vItem(UBound(vItem))))
                    Exit For
                End If
            Next i
            Set olFolder = Session.GetDefaultFolder(olFolderInbox)    'the folder where the messages are stored
            Set olItems = olFolder.Items
            olItems.Sort "[Received]", True
            For i = 1 To olItems.Count
                Set olMsg = olItems(i)
                If Format(olMsg.ReceivedTime, "dd mmmm yyyy HH:MM") = strTime Then
                    vSubject = Split(LCase(olMsg.Subject), Chr(58))
                    If strSubject = Trim(LCase(vSubject(UBound(vSubject)))) And _
                       strName = LCase(olMsg.Sender.Name) Then
                        olMsg.Categories = "Worked"
                        olMsg.Save
                        Exit For
                    End If
                End If
            Next i
        End If
    End With
lbl_Exit:
    Set olFolder = Nothing
    Set olItems = Nothing
    Set olMsg = Nothing
    Exit Sub
End Sub