Option Explicit
Sub MoveToFolder(olMail As Outlook.MailItem)
Dim strNum As String
Dim strText As String
Dim olOutMail As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim strFolder As String
Dim wdDoc As Object
Dim oRng As Object
Dim iCount As Long
    iCount = 0
    strNum = "<5555>"
    strText = "1 rating"
    strFolder = "1 Rating Folder" 'Folder must exist!
    With olMail
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        With oRng.Find
            Do While .Execute(FindText:=strNum, MatchWildCards:=True)
                iCount = iCount + 1
                Exit Do
            Loop
        End With
        Set oRng = wdDoc.Range
        With oRng.Find
            Do While .Execute(FindText:=strText, MatchWildCards:=False, MatchCase:=False)
                iCount = iCount + 1
                Exit Do
            Loop
        End With
    End With
    If iCount = 2 Then
        Set olOutMail = olMail.Forward
        With olOutMail
            .To = "example@gmayor.com"
            .sEnd
        End With
        olMail.Move Session.GetDefaultFolder(olFolderInbox).folders(strFolder)
    End If
lbl_Exit:
    Exit Sub
End Sub

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