Word表格数据通过VBA导入Excel后部分字体莫名变黄的问题排查求助

各位大佬好，我现在碰到个棘手的问题：学生们用Word填写表格提交，其中部分内容需要用特定颜色字体才能拿满分。我写了VBA脚本把他们提交的Word文档里的数据和字体颜色导入Excel，大部分内容显示都正常，但总有一些内容导入后字体变成黄色或橙色，完全不符合预期。

我已经排查了几个最可能的原因，但都排除了：

• 确认原Word文档里对应单元格的字体根本不是黄/橙色
• 每次运行宏前都清理了目标Excel工作表的格式，排除了上次运行的残留影响
• 怀疑是Word保护文档时出现的黄色编辑字段导致的，专门写了FixHighlights子过程去处理，但运行后完全没效果

以下是完整的VBA脚本代码，麻烦各位帮忙看看哪里可能出问题了：

Public Sub ImportWordData(folderPath As String)

Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Dim fso As Scripting.FileSystemObject
Dim aFold As Scripting.Folder, aFile As Scripting.File
Dim rngOutput As Range
Dim wRange(0 To 20) As Word.Range
Dim strOutput As String
Dim lColor(0 To 20) As Long, lBColor(0 To 20) As Long
Dim lTable(0 To 1) As Long
Dim i As Long, x As Long, y As Long, z As Long

wksRaw.Cells.Clear
Set fso = New FileSystemObject
Set aFold = fso.GetFolder(folderPath)
Set wordApp = New Word.Application
Set rngOutput = wksRaw.Range("B2")

lTable(0) = wksStart.Range("G5").Value
lTable(1) = wksStart.Range("G6").Value

For Each aFile In aFold.Files
    If InStr(1, aFile.Name, "~") > 0 Or InStr(1, aFile.Name, "Importer") Then GoTo SkipLoop
    Set wordDoc = wordApp.Documents.Open(aFold.Path & Application.PathSeparator & aFile.Name)
    
    Call FixHighlights(wordApp, wordDoc)
    
    Set wRange(0) = wordDoc.Tables(lTable(0)).Rows(3).Cells(3).Range
    Set wRange(1) = wordDoc.Tables(lTable(0)).Rows(3).Cells(1).Range
    lColor(0) = wordDoc.Tables(lTable(0)).Rows(3).Cells(3).Range.Font.Color
    lColor(1) = wordDoc.Tables(lTable(0)).Rows(3).Cells(3).Range.Font.Color
    Debug.Print ("0: " & lColor(0) & " 1: " & lColor(1))
    
    x = 10
    For i = 3 To 10
        Set wRange(i - 1) = wordDoc.Tables(lTable(0)).Rows(i).Cells(2).Range
        lColor(i - 1) = wordDoc.Tables(lTable(0)).Rows(i).Cells(2).Range.Font.Color
    Next i
    
    For i = 2 To 6 Step 2
        Set wRange(x) = wordDoc.Tables(lTable(1)).Cell(19, i).Range
        lColor(x) = wordDoc.Tables(lTable(1)).Cell(19, i).Range.Font.Color
        x = x + 1
    Next i
    
    For i = 4 To 13
        If i = 8 Then i = 10
        Set wRange(x) = wordDoc.Tables(lTable(1)).Cell(i, 2).Range
        lColor(x) = wordDoc.Tables(lTable(1)).Cell(i, 2).Range.Font.Color
        x = x + 1
    Next i
    
    rngOutput.Cells(z + 1, 1).Value = wordDoc.Name
    For i = 0 To 20
        strOutput = WorksheetFunction.Trim(WorksheetFunction.Clean(wRange(i).Text))
        rngOutput.Cells(z + 1, i + 2).Value = strOutput
        rngOutput.Cells(z + 1, i + 2).Font.Color = lColor(i)
    Next i
    
    z = z + 1
    wordDoc.Close False
SkipLoop:
Next aFile

wksRaw.UsedRange.EntireColumn.ColumnWidth = 15
On Error Resume Next
wksRaw.Activate
On Error GoTo 0

wordApp.Quit False
Set fso = Nothing
Set wordDoc = Nothing
Set wordApp = Nothing
On Error GoTo 0
End Sub

Sub FixHighlights(wApp As Word.Application, wDoc As Word.Document)
Dim oFF As FormField
On Error Resume Next
wDoc.FormFields.Shaded = False
If wDoc.ProtectionType = wdAllowOnlyFormFields Then wDoc.Unprotect
For Each oFF In wDoc.FormFields
    oFF.Range.HighlightColorIndex = wdNoHighlight
Next
wDoc.Protect wdAllowOnlyFormFields, NoReset:=True, Password:=""
wApp.ActiveWindow.View.ShadeEditableRanges = False
On Error GoTo 0
End Sub

举个例子，下图里的表格日期单元格，导入到Excel后字体就变成黄色了：

麻烦各位帮忙分析下问题可能出在哪，或者有没有其他排查方向？谢谢！

备注：内容来源于stack exchange，提问作者Starnes Student