mana,
You seem to have a good handle on dictionaries ;-)
If we conclude that a word is something that is delimited in a document by white space then the following may get us closer to a workable solution:
Code:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 8/1/2017
Dim oWord As Range
Dim oRng As Word.Range
Dim lngCount As Long
Dim lngIndex As Long
Dim lngMark As Long
lngCount = InputBox("Enter the number of words to count", "Word Count", "25")
With ActiveDocument
For lngIndex = .Comments.Count To 1 Step -1
If InStr(.Comments(lngIndex).Range.Text, "[Word Count:") > 0 Then
.Comments(lngIndex).Delete
End If
Next
Set oRng = ActiveDocument.Range
End With
lngMark = 0
Do
For Each oWord In oRng.Words
If oWord.InRange(oRng) Then
If Not fcnIsWhiteSpace(oWord) Then
lngIndex = lngIndex + 1
Do Until fcnIsWhiteSpace(oWord.Characters.Last) Or fcnIsWhiteSpace(oWord.Characters.Last.Next)
oWord.MoveEnd wdWord, 1
oRng.Start = oWord.Duplicate.End
Loop
Do While fcnIsWhiteSpace(oWord.Characters.Last) Or oWord.Characters.Last Like "[)}:;./?/!" & Chr(148) & "," & Chr(34) & "]"
oWord.MoveEnd wdCharacter, -1
Loop
Do Until oWord.Characters.Last <> "]"
oWord.MoveEnd wdCharacter, -1
Loop
If lngIndex = lngCount Then
lngMark = lngMark + lngIndex
lngIndex = 0
oRng.Comments.Add oWord, "[Word Count: " & lngMark & "]"
End If
End If
End If
Next
Loop Until oRng.End = ActiveDocument.Range.End
'Here is where we coudld convert the comments to "instring" flags as the OP requested.
' For lngIndex = ActiveDocument.Comments.Count To 1 Step -1
' If Left(ActiveDocument.Comments(lngIndex).Range.Text, 11) = "[Word Count" Then
' Set oRng = ActiveDocument.Comments(lngIndex).Reference
' oRng.InsertAfter "/"
' ActiveDocument.Comments(lngIndex).Delete
' End If
' Next
lbl_Exit:
Exit Sub
End Sub
Private Function fcnIsWhiteSpace(oRngEndCharacter As Range) As Boolean
'If its nothing the it isn't whitespace!
fcnIsWhiteSpace = False
If Not oRngEndCharacter Is Nothing Then
Select Case AscW(oRngEndCharacter.Text)
Case 8194, 8195, 8197, 9, 11, 13, 32, 160: fcnIsWhiteSpace = True
End Select
End If
End Function