title: List fonts used by a Word Document (faster method)
body: <p>I am working on a process for validating documents to make sure that they meet corporate standards.  One of the steps is to make sure that the Word document does not use non-approved fonts.</p>
  
  <p>I have the following stub of code, which works:</p>
  
  <pre><code>    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
  </code></pre>
  
  <p>But this is <strong>incredibly</strong> slow!  Incredibly slow = 2500 characters/minute (I timed it with StopWatch).  Most of my files are around 6,000 words/30,000 characters (about 25 pages).  But there are some documents that are in the 100's of pages...</p>
  
  <p>Is there a faster way of doing this?  I have to support Office 2003 format files, so the Open XML SDK isn't an option.</p>
  
  <p><strong>--UPDATE--</strong></p>
  
  <p>I tried running this as a Word macro (using the code found @ <a href="http://word.tips.net/Pages/T001522_Creating_a_Document_Font_List.html" rel="noreferrer">http://word.tips.net/Pages/T001522_Creating_a_Document_Font_List.html</a>) and it runs much faster (under a minute).  Unfortunately for my purposes I don't believe a Macro will work.</p>
  
  <p><strong>--UPDATE #2--</strong></p>
  
  <p>I took Chris's advice and converted the document to Open XML format on the fly.  I then used the following code to find all RunFonts objects and read the font name:</p>
  
  <pre><code>    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
  </code></pre>