Загрузка информации из файлов Word (перебор страниц в документе)

Function DocumentProperties(ByRef doc As Object) As Variant
    On Error Resume Next: Err.Clear
    ' формирует статистику по документу Word
    ' возвращает двумерный массив из 3 столбцов,
    ' а строк в массиве столько, сколько страниц в документе DOC.
    ' 1 столбец: номер страницы + статистика (количество абзацев, слов и букв)
    ' 2 столбец - текст, с которого начинается страница
    ' 3 столбец - текст, которым заканчивается страница

    Dim pg As Object, oRng As Object, pos1&, pos2&
    pc& = doc.Range.Information(4)
    ReDim arr(1 To pc&, 1 To 3)
 
    For n = 1 To pc&
        pos1& = doc.Range.GoTo(1, 2, , n).Start   ' wdGoToPage = 1, wdGoToNext = 2
        If n = pc& Then
            pos2& = doc.Range.End
        Else
            pos2& = doc.Range.GoTo(1, 2, , n + 1).Start
        End If
 
        Set oRng = Nothing: Set oRng = doc.Range(pos1&, pos2& - 1)
 
        arr(n, 1) = "Страница: " & n & vbLf & _
                    "  абзацев: " & oRng.Paragraphs.Count& & vbLf & _
                    "  символов: " & (pos2& - pos1& - 1)
 
        txt = "": txt = Replace(oRng.Text, vbNewLine, " ")
        txt1$ = Left(txt, 50): sp& = 0: sp& = InStrRev(txt1, " ")
        If sp& > 1 Then txt1 = Left(txt1, sp& - 1)
        txt2$ = Right(txt, 50): sp& = 0: sp& = InStr(1, txt2, " ")
        If sp& > 1 Then txt2 = Mid(txt2, sp& + 1)
        arr(n, 2) = Trim(Application.Trim(Application.Clean(txt1)))
        arr(n, 3) = Trim(Application.Trim(Application.Clean(txt2))) 'Replace(txt2, Chr(13), vbLf)
    Next
    DocumentProperties = arr
End Function

        ' загружаем данные из файла Word
        Set doc = Nothing
        Set doc = WA.Documents.Open(filename$, , True)
 
        If doc Is Nothing Then ' если документ не открылся
            cell.Resize(, 5).Value = Array(index&, ShortFilename$, subfolder$, DateCreated, FileSize&)
            cell.Offset(, 5) = "Не удалось открыть файл DOC"
 
        Else ' документ успешно открыт
            arr = "": arr = DocumentProperties(doc)
 
            If IsArray(arr) Then ' если удалось загрузить данные из документа Word
                cell.Resize(UBound(arr), 5).Value = Array(index&, ShortFilename$, subfolder$, DateCreated, FileSize&)
                cell.Offset(, 5).Resize(UBound(arr), 3).Value = arr ' выводим результаты на лист
            
            Else
                cell.Resize(, 5).Value = Array(index&, ShortFilename$, subfolder$, DateCreated, FileSize&)
                cell.Offset(, 5) = "Не удалось загрузить данные из файла"
            End If
            doc.Close False ' закрываем файл DOC
        End If