Maybe one of the MS gurus has a better (or more technical) answer, but
a quick and dirty method (well, maybe not so quick, but definitely
dirty) would be to drag the .doc file into NOTEPAD and manually scan
for the font names, which should appear as text strings in a group
near the end of the file.

 - Character

Here is a word macro (between the two long line), if you know how to run it:
_______________________________________________________________________
Public Sub ListFontsInDoc()
'
' FontsUsed Macro
' Macro created 05.04.21
'
Dim FontList(199) As String
Dim FontCount As Integer
Dim FontName As String
Dim j As Integer, K As Integer, L As Integer
Dim X As Long, Y As Long
Dim FoundFont As Boolean
Dim rngChar As Range
Dim strFontList As String

FontCount = 0
X = ActiveDocument.Characters.Count
Y = 0
' For-Next loop through every character
For Each rngChar In ActiveDocument.Characters
Y = Y + 1
FontName = rngChar.Font.Name
StatusBar = Y & ":" & X
' check if font used for this char already in list
FoundFont = False
For j = 1 To FontCount
If FontList(j) = FontName Then FoundFont = True
Next j
If Not FoundFont Then
FontCount = FontCount + 1
FontList(FontCount) = FontName
End If
Next rngChar

' sort the list
StatusBar = "Sorting Font List"
For j = 1 To FontCount - 1
L = j
For K = j + 1 To FontCount
If FontList(L) > FontList(K) Then L = K
Next K
If j <> L Then
FontName = FontList(j)
FontList(j) = FontList(L)
FontList(L) = FontName
End If
Next j

StatusBar = ""
' put in new document
Documents.Add
Selection.TypeText Text:="There are " & FontCount & " fonts used in the
document, as follows:"
Selection.TypeParagraph
Selection.TypeParagraph
For j = 1 To FontCount
Selection.TypeText Text:=FontList(j)
Selection.TypeParagraph
Next j

End Sub
________________________________________________________________________

It will give in a new document the Menu Names of the used fonts.
If you embed into the Normal.dot, you can run anytime as needed.

zzsido

Hi asur!

Here is a better macro. Try this.

--------------------------------------------------------------------------------

Sub ListFontsInDoc()
'
' FontsInDocList Macro
' Macro created 06.11.30 by zzsido
'
Dim FontList(199) As String
Dim FontCount As Integer
Dim FontName As String
Dim j As Integer, k As Integer, L As Integer
Dim X As Long, Y As Long, lngJunk As Long
Dim FoundFont As Boolean
Dim rngChar As Range
Dim strFontList As String
Dim rngStory As Word.Range
Dim oShp As Shape

FontCount = 0
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
' Iterate through all story types in the current document

For Each rngStory In ActiveDocument.StoryRanges
   'Iterate through all linked stories
 Do
   For Each rngChar In ActiveDocument.Characters
     FontName = rngChar.Font.Name
     FoundFont = False
     For j = 1 To FontCount
       If FontList(j) = FontName Then FoundFont = True
     Next j
     If Not FoundFont Then
       FontCount = FontCount + 1
       FontList(FontCount) = FontName
     End If
   Next rngChar
       
   On Error Resume Next
   Select Case rngStory.StoryType
   Case 5, 6, 7, 8, 9, 10, 11
     If rngStory.Characters.Count > 0 Then
       For Each rngChar In rngStory.Characters
         FontName = rngChar.Font.Name
         FoundFont = False
         For j = 1 To FontCount
           If FontList(j) = FontName Then FoundFont = True
         Next j
         If Not FoundFont Then
           FontCount = FontCount + 1
           FontList(FontCount) = FontName
         End If
       Next rngChar
     End If

     If rngStory.ShapeRange.Count > 0 Then
       For Each oShp In rngStory.ShapeRange
         If oShp.TextFrame.TextRange.Characters.Count > 0 Then
           For Each rngChar In oShp.TextFrame.TextRange.Characters
             FontName = rngChar.Font.Name
             FoundFont = False
             For j = 1 To FontCount
               If FontList(j) = FontName Then FoundFont = True
             Next j
             If Not FoundFont Then
               FontCount = FontCount + 1
               FontList(FontCount) = FontName
             End If
           Next rngChar
         End If
       Next
     End If
   Case Else
   End Select
   On Error GoTo 0
'   Get next linked story (if any)
   Set rngStory = rngStory.NextStoryRange
 Loop Until rngStory Is Nothing
Next

If ActiveDocument.Shapes.Count > 0 Then
 For Each oShp In ActiveDocument.Shapes
   If Left(oShp.Name, 7) = "WordArt" Then
     FontName = oShp.TextEffect.FontName
     FoundFont = False
     For j = 1 To FontCount
       If FontList(j) = FontName Then FoundFont = True
     Next j
     If Not FoundFont Then
       FontCount = FontCount + 1
       FontList(FontCount) = FontName
     End If
   End If
 Next oShp
End If

' sort the list
StatusBar = "Sorting Font List"
For j = 1 To FontCount - 1
 L = j
 For k = j + 1 To FontCount
   If FontList(L) > FontList(k) Then L = k
 Next k
 If j <> L Then
   FontName = FontList(j)
   FontList(j) = FontList(L)
   FontList(L) = FontName
 End If
Next j

StatusBar = ""
' put in new document
Documents.Add
Selection.TypeText Text:="There are " & FontCount & " fonts used " _
& "in the document (except inserted symbols), as follows:"
Selection.TypeParagraph
Selection.TypeParagraph
For j = 1 To FontCount
 Selection.TypeText Text:=FontList(j)
 Selection.TypeParagraph
Next j

End Sub

--------------------------------------------------------------------------------

Regards,
zzsido