How can I loop through every letter in MS Word using VBA?

Question

I have about 100 Word documents which include transliteration of foreign names. The author of these documents used a special font called e2 which has about a dozen special transliteration characters (all of which are available in Microsoft Sans Serif font).

I would like to loop through every letter of the document and whenever the .Font = "e2" I would like to loop through the dozen letters (it's easy to guess what they are) and replace them with a Microsoft Sans Serif equivalent. But I can't figure out how you can loop though letters. Is that doable like looping through cells in an Excel spreadsheet?

Answer 1

This would be one way to do it, but depending on the size of the document, it may take a long time to execute.

Sub ChangeFonts()
Dim doc As Document
Set doc = ActiveDocument

For i = 1 To doc.Range.Characters.Count
    If doc.Range.Characters(i).Font.Name = "e2" Then
        doc.Range.Characters(i).Font.Name = "Microsoft Sans Serif"
    End If
Next

End Sub

Answer 2

You could also save it as docx, open it in a zip file and do a search/replace inside document.xml and fontTable.xml.

Answer 3

Way faster:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Font.Name = "e2"
    .Replacement.Font.Name = "Microsoft Sans Serif"
    .Forward = True
    .Format = True
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub

Answer 4

use the mswords format find & replace. You will save time & large file won't be a concern.