How to loop through every word in a word document to modify the format of specific words-CodePudding

I'm struggling to find a way to loop through every word in a Word document and make the word bold if it's in a list of predefined words/terms. The predefined list is in strCollection.

Sub BoldWords()

Dim strCollection(2) As String
    
strCollection(0) = "test"
strCollection(1) = "john"
strCollection(2) = "later"

For Each strWord In ActiveDocument.Words
    'If the strWord is in the strCollection
        'strWord.Font.BOLD = True
    'End If
Next strWord

End Sub

I can loop through the words okay, but I can't seem to figure out how to do the conditional logic to check if the word is in an array. I don't do a lot of VBA so I appreciate any help here.

I've looked at other answers to this question like this one but they don't run at all. Maybe they're for older versions of Word? I'm on O365.

CodePudding user response：

You will need a nested loop to compare the word with each key in the collection, and then do stuff with it. It also might be a matter of putting this code in the Document_Open() event handler so that it runs when the document is opened.

Private Sub Document_Open()

    Dim colCollection : Set colCollection = CreateObject("Scripting.Dictionary")
    Dim strWord, Key
        
    colCollection.Add 0, "test"
    colCollection.Add 1, "john"
    colCollection.Add 2, "later"

    For Each strWord In ActiveDocument.Words
        For Each Key in colCollection.Keys
            If strWord = colCollection.Item(Key) Then
                strWord.Font.Bold = True
            End If
        Next
    Next

End Sub

Also see: How to create collection object in vbscript?
Also see: https://docs.microsoft.com/en-us/office/vba/api/word.document.open

CodePudding user response：

Looping through every Word in a document is terribly inefficient. You should instead consider using Find/Replace. For example:

Sub BoldWords()
Application.ScreenUpdating = False
Dim ArrFnd As Variant, i As Long
'Array of Find expressions
ArrFnd = Array("test", "john", "later")
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Format = False
  .Forward = True
  .MatchCase = False
  .MatchWholeWord = True
  .Replacement.Text = "^&"
  .Replacement.Font.Bold = True
   'Process each item from ArrFnd
  For i = 0 To UBound(ArrFnd)
    .Text = ArrFnd(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub