我有以下代码存根,它有效：

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字符/分钟(我用StopWatch计时).我的大多数文件大约是6000字/ 30,000个字符(约25页).但有一些文件在100页的页面中……

有更快的方法吗？我必须支持Office 2003格式文件,因此Open XML SDK不是一个选项.

–UPDATE–

我尝试将其作为Word宏运行(使用@ http://word.tips.net/Pages/T001522_Creating_a_Document_Font_List.html找到的代码)并且运行速度更快(在一分钟之内).不幸的是,出于我的目的,我不相信宏会起作用.

– 更新#2–

我接受了Chris的建议并将文档转换为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