Importing word tables into excel with formatting

Question

I need to import a word document with lots of tables into an excel worksheet. This is easy enough, but the caveat is to keep the formatting of the word doc as it's entered into excel. For instance, some of the fields in word are the color blue, some are red. some are blue with underscore and some are red with underscore. Basically, any color in the word doc needs to match in the excel sheet. This is my code for doing the actual import.

Sub ImportWordTables_1()
    Dim wdDoc As Object
    Dim wdFileName As Variant
    Dim TableNo As Long 'table number in Word
    Dim iRow As Long 'row index in Excel
    Dim iCol As Long 'column index in Excel
    Dim tblCount As Long
    wdFileName = Application.GetOpenFilename("Word files,*.doc;*.docx", , _
        "Browse for file containing table to be imported")
    If wdFileName = False Then Exit Sub '(user cancelled import file browser)
    Set wdDoc = GetObject(wdFileName) 'open Word file
    With wdDoc
        TableNo = wdDoc.tables.Count
        If TableNo = 0 Then
            MsgBox "This document contains no tables", vbExclamation, "Import Word Table"
        End If
        tblStart = InputBox("Enter table number to start with", "Table Start")
        iCol = 1
        For tblCount = tblStart To .tables.Count
            With .tables(tblCount)
                'copy cell contents from Word table cells to Excel cells
                For iRow = 1 To .Rows.Count
                    'find the last empty row in the current worksheet
                    nextRow = ThisWorkbook.ActiveSheet.Range("a" _
                        & Rows.Count).End(xlUp).Row + 1
                    'Just 1 column for now
                    'For iCol = 1 To .Columns.Count
                    ThisWorkbook.ActiveSheet.Cells(nextRow, iCol) = WorksheetFunction _
                        .Clean(.cell(iRow, iCol).Range.Text)
                    'ThisWorkbook.ActiveSheet.Cells(nextRow, iCol) = _
                        .cell(iRow, iCol).Range.Text
                    'Next iCol
                Next iRow
            End With
        Next
    End With
    Set wdDoc = Nothing
End Sub

Your code is doing the transferring fine, but it's not retaining the formatting, is that correct? — Raystafarian, Jul 20 '15 at 15:55
I'm not really sure how to modify my code to fit the examples in your link. I only want the first column from the word tables. — Matt Williamson, Jul 20 '15 at 16:57

score 1 · Answer 1 · answered Jul 20 '15 at 18:07

1

Try replacing this line -

ThisWorkbook.ActiveSheet.Cells(nextRow, iCol) = WorksheetFunction _
.Clean(.cell(iRow, iCol).Range.Text)

With this instead -

.cell(iRow, iCol).Range.Copy
ThisWorkbook.ActiveSheet.Cells(nextrow, iCol).Activate
ThisWorkbook.ActiveSheet.Paste

Obviously you could clean this up a bit by using some variables, but that's the basic idea.

answered Jul 20 '15 at 18:07

Raystafarian

2,902
2
29
42

Thanks for this code . This works quite well, but it's much slower and brings in a lot of extra stuff I don't want. All I want is the foreground color, background color and bold, underline or strikeout. I can clean it up after the copy and paste but that doesn't help that it takes 5x as long. – Matt Williamson Jul 22 '15 at 12:08
Then change the paste to pastespecial and select what you need? – Raystafarian Jul 22 '15 at 12:33
I tried that already. At least, doing it manually. Not many options really. – Matt Williamson Jul 22 '15 at 13:32
Well you already have a macro running, check the source for each of the things you want, set a boolean and then apply it once it transfers – Raystafarian Jul 22 '15 at 13:38

score 0 · Answer 2 · answered Apr 25 '18 at 08:58

Try this (example with one blue color, but the best you can do is checking which is your blue, red... in Word):

 If .Cell(iRow, iCol).Shading.BackgroundPatternColor = RGB(85, 60, 232) Then
                 Cells(nextrow, iCol).Interior.Color = RGB(85, 60, 232)

It worked for me.

Importing word tables into excel with formatting

2 Answers2