Paul's suggestion could possibly solve your problem. The only other alternative and the code would take a while to run would be to evaluate ever character in the text. Something like this perhaps:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Word.Range
Application.ScreenUpdating = False
Set oRng = ActiveDocument.Range.Characters.First
Do
If oRng.Font.Name <> "Times New Roman" Then
oRng.Comments.Add oRng, oRng.Font.Name
End If
oRng.MoveStart wdCharacter, 1
oRng.MoveEnd wdCharacter, 1
Loop Until oRng.End = ActiveDocument.Characters.Last.End
Application.ScreenUpdating = True
End Sub