Перебор всех текстовых элементов в документе

On Error Resume Next
        Set oWord = GetObject(, "Word.Application") 'Ищем уже открытый Word
        If Err.Number <> 0 Then 'Если не нашли - создаём новый экземпляр
            Err.Clear
            Set oWord = CreateObject("Word.Application")
        End If
        If oWord Is Nothing Then
            MsgBox "Невозможно создать экземпляр приложения MS Word!", vbCritical, vbNullString
            Exit Sub
        End If
        
        Set oDoc = oWord.Documents.Open(fileIn)

        If Err.Number <> 0 Then
           MsgBox "Ошибка при открытии модифицируемого документа"
           Exit Sub
        End If
        
        For i% = 1 To oDoc.Sentences.Count
            longStr = ConvertStrToNum(oDoc.Sentences(i).Text, True)
            If longStr <> oDoc.Sentences(i).Text Then oDoc.Sentences(i).Text = longStr
        Next i
        oDoc.SaveAs2 (fileOut)

Dim rng As Object, oWord As Object

Set oWord = CreateObject("Word.Application")

With oWord
    .Documents.Open filename:=fileIn, ReadOnly:=False
                
    iCount = .ActiveDocument.Sentences.Count
    For i% = 1 To iCount
         Set rng = .ActiveDocument.Sentences(i)
         strIn = .ActiveDocument.Sentences(i).Text
         longStr = ConvertStrToNum(strIn, True)
         If Trim(longStr) <> Trim(strIn) Then
              .ActiveDocument.Range(rng.Start, rng.End).Text = longStr
         End If
    Next i
    .ActiveDocument.Close (True)
    .Quit
End With
Set oWord = Nothing