VBA importing yellow text into Excel from Word?

Mandated 0 Reputation points
2023-04-01T05:56:06.7533333+00:00

I posted this a while back on Super User, but never got a response.

Students fill out some tables in Word, and they must occasionally use a certain color font to get full credit. I'm using VBA to import their data and the color of their font from their submitted documents. Most of this comes out looking correct, but some comes out with yellow or orange font.

The most likely causes would be that the font was colored in those shades in the origin file or that there isn't any cleanup of formats being done before the macro is run again, but I've checked to make sure those aren't the case. As you can see in the pictures, the Word document doesn't show any sign of yellow font. The first picture is the results in Excel, so look at Lab 23 which has a date in yellow font, and compare it to the second picture of Lab 23 which appears in blue font. Code is below for entire script:

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

User's image

User's image

Microsoft 365
Microsoft 365
Formerly Office 365, is a line of subscription services offered by Microsoft which adds to and includes the Microsoft Office product line.
3,766 questions
Word
Word
A family of Microsoft word processing software products for creating web, email, and print documents.
657 questions
Excel
Excel
A family of Microsoft spreadsheet software with tools for analyzing, charting, and communicating data.
1,457 questions
Office Development
Office Development
Office: A suite of Microsoft productivity software that supports common business tasks, including word processing, email, presentations, and data management and analysis.Development: The process of researching, productizing, and refining new or existing technologies.
3,479 questions

1 answer

Sort by: Most helpful
Most helpful Newest Oldest
  1. Mark Woodland 0 Reputation points
    2023-05-15T17:16:27.7466667+00:00

    I do not have an answer but would point out that the option to display field shading is irrelevant to your result in Excel. That is a Word display option. wDoc.FormFields.Shaded = False It is likely that the students are using theme colors rather than set colors. To assist in diagnosing this, a sample Word file that gives the problem would be helpful. I believe that you can use the paperclip in the editor here to attach a file. The following is for use in a forum where a link is required instead of an attachment but it contains information on how to clean a file of proprietary or confidential information. How to prepare a sample document to post. You may want to look at [Quick] Style Sets and Themes in Word.

    Didn't help me this. Any other option do you have?

    0 comments