Sub MoveToFolder(olMail As Outlook.MailItem)
Dim strText As String
Dim olOutMail As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim iCount As Long
Dim vEmail As Variant
Dim vNum As Variant
Dim i As Long
Const strFolder As String = "1 Rating Folder"        'folder must exist
Const strNum As String = "<5555>|<1111>"        'separate search strings with '|'
Const strEmail As String = "jane@example.com|mike@example.com"        'Corresponding e-mail addresses to strNum

strText = "1 rating"        'Common folder
    vEmail = Split(strEmail, "|")
    vNum = Split(strNum, "|")
    
    Set olInsp = olMail.GetInspector
    Set wdDoc = olInsp.WordEditor

    For i = LBound(vNum) To UBound(vNum)
        With olMail
            iCount = 0
            Set oRng = wdDoc.Range
            With oRng.Find
                Do While .Execute(FindText:=vNum(i), 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 = vEmail(i)
                .sEnd
            End With
            olMail.Move Session.GetDefaultFolder(olFolderInbox).folders(strFolder)
        End If
    Next i
lbl_Exit:
    Exit Sub
End Sub