Список шрифтов, используемых в документе Word (более быстрый метод)

Я работаю над процессом проверки документов, чтобы убедиться, что они соответствуют корпоративным стандартам. Один из шагов - убедиться, что в документе Word не используются неутвержденные шрифты.

У меня есть следующая заглушка кода, которая работает:

    Dim wordApplication As Word.ApplicationClass = New Word.ApplicationClass()
    Dim wordDocument As Word.Document = Nothing

    Dim fontList As New List(Of String)()

    Try
        wordDocument = wordApplication.Documents.Open(FileName:="document Path")
        'I've also tried using a for loop with an integer counter, no change in speed'
        For Each c As Word.Range In wordDocument.Characters
            If Not fontList.Contains(c.Font.Name) Then
                fontList.Add(c.Font.Name)
            End If
        Next

Но это невероятно медленно! Невероятно медленно = 2500 символов в минуту (я засек с помощью секундомера). Большинство моих файлов содержат около 6000 слов / 30 000 символов (около 25 страниц). Но есть документы, которые занимают сотни страниц ...

Есть ли более быстрый способ сделать это? Мне нужно поддерживать файлы формата Office 2003, поэтому Open XML SDK не подходит.

- ОБНОВЛЕНИЕ -

Я пробовал запустить это как макрос Word (используя найденный код @ http: //word.tips.net/Pages/T001522_Creating_a_Document_Font_List.html) и работает намного быстрее (менее чем за минуту). К сожалению, для моих целей я не верю, что макрос будет работать.

- ОБНОВЛЕНИЕ №2 -

Я последовал совету Криса и на лету преобразовал документ в формат Open XML. Затем я использовал следующий код, чтобы найти все объекты RunFonts и прочитать имя шрифта:

    Using docP As WordprocessingDocument = WordprocessingDocument.Open(tmpPath, False)
        Dim runFonts = docP.MainDocumentPart.Document.Descendants(Of RunFonts)().Select(
                            Function(c) If(c.Ascii.HasValue, c.Ascii.InnerText, String.Empty)).Distinct().ToList()

        fontList.AddRange(runFonts)
    End Using