How to preserve source formatting while copying data from word table to excel sheet using VB macro?

Question

I am trying to copy some data from a word table to an excel sheet using a VB Macro.

It is copying the text perfectly as desired.

Now i want to preserve the source formatting present in word doc.

The things I want to preserve are

Strike Through
Color
Bullets
New Line Character

I am using the following code to copy -

objTemplateSheetExcelSheet.Cells(1, 2) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)

Kindly let me know how I can edit this so as to preserve source formatting.

The logic I am using is as follows -

wdFileName = Application.GetOpenFilename("Word files (*.*),*.*", , _
"Browse for file containing table to be imported") '(Browsing for a file)

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) '(open Word file)

With wdDoc
    'enter code here`
    TableNo = wdDoc.tables.Count '(Counting no of tables in the document)
    If TableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    End If
End With

I am running a table count on the word file. Then for all the tables present in the word doc accessing each row and column of the tables using the above mentioned code.

Ok I am attaching the remaining piece of code as well

'Creating TemplateSheet object
Set objTemplateSheetExcelApp = CreateObject("Excel.Application")
'Opening the template to be used
objTemplateSheetExcelApp.Workbooks.Open ("C:\Temp\Documents Page XX_US-VC Combo Template.xlsx")
Set objTemplateSheetExcelWkBk = objTemplateSheetExcelApp.ActiveWorkbook.Worksheets(5)
Set objTemplateSheetExcelSheet = objTemplateSheetExcelApp.ActiveWorkbook.Worksheets(5) '(Selecting the desired tab)

tblcount = 1
For tblcount = 1 To TableNo
    With .tables(tblcount)
    'copy cell contents from Word table cells to Excel cells
    For iRow = 1 To .Rows.Count
        For iCol = 1 To .Columns.Count
            On Error Resume Next
            strEach = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
            For arrycnt = 0 To 15
                YNdoc = InStr(strEach, myArray(arrycnt))
                    If (YNdoc > 0) Then
                        objTemplateSheetExcelSheet.Cells(2, yourArray(arrycnt)) = _
                        WorksheetFunction.Clean(.cell(iRow, iCol + 1).Range.Text)
                            If arrycnt = 3 Or arrycnt = 6 Then
                                objTemplateSheetExcelSheet.Cells(2, yourArray(arrycnt) + 1) = _
                                WorksheetFunction.Clean(.cell(iRow + 1, iCol + 1).Range.Text)
                            End If
                    End If
            Next arrycnt
        Next iCol
    Next iRow
    End With
    Next tblcount
End With
intRow = 1

'To save the file
strFileName = "Newfile.xlsx"
objTemplateSheetExcelWkBk.SaveAs strFld & "\" & strFileName

objTemplateSheetExcelApp.Quit

Set objTemplateSheetExcelApp = Nothing
Set objTemplateSheetExcelWkBk = Nothing
Set objTemplateSheetExcelSheet = Nothing

Set wdDoc = Nothing

I have edited the file to contain the entire code now. The line "WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)" is the main code for copying the data from word. — user1643371, Sep 03 '12 at 11:57
In that case you really are doing it in a very complex way. Let me post an answer with an example. Gimme some time. It will be a very long post... — Siddharth Rout, Sep 03 '12 at 12:24

score 8 · Answer 1 · answered Sep 03 '12 at 12:54

To interact with Word from Excel, you can choose either Early Binding or Late Binding. I am using Late Binding where you do not need to add any references.

I will cover the code in 5 parts

Binding with a Word Instance
Opening the Word document
Interacting with Word Table
Declaring Your Excel Objects
Copying the word table to Excel

A. Binding with a Word Instance

Declare your Word objects and then bind with either an existing instance of Word or create a new instance. For example

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True
End Sub

B. Opening the Word document

Once you have connected with/created the Word instance, simply open the word file.. See this example

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object
    Dim FlName As String

    FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _
             "Browse for file containing table to be imported")

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True

    '~~> Open the Word document
    Set oWordDoc = oWordApp.Documents.Open(FlName)
End Sub

C. Interacting with Word Table

Now you have the document open, Let's connect with say Table1 of the word document.

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object
    Dim FlName As String
    Dim tbl As Object

    FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _
             "Browse for file containing table to be imported")

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True

    Set oWordDoc = oWordApp.Documents.Open(FlName)

    Set tbl = oWordDoc.Tables(1)
End Sub

D. Declaring Your Excel Objects

Now we have the handle to the Word Table. Before we copy it, let's set our Excel objects.

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object
    Dim FlName As String
    Dim tbl As Object

    FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _
             "Browse for file containing table to be imported")

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True

    Set oWordDoc = oWordApp.Documents.Open(FlName)

    Set tbl = oWordDoc.Tables(1)

    '~~> Excel Objects
    Dim wb As Workbook, ws As Worksheet

    Set wb = Workbooks.Open("C:\Temp\Documents Page XX_US-VC Combo Template.xlsx")

    Set ws = wb.Sheets(5)
End Sub

E. Copying the word table to Excel

And finally when we have the destination all set, simply copy the table from word to Excel. See this.

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object
    Dim FlName As String
    Dim tbl As Object

    FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _
             "Browse for file containing table to be imported")

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True

    Set oWordDoc = oWordApp.Documents.Open(FlName)

    Set tbl = oWordDoc.Tables(1)

    '~~> Excel Objects
    Dim wb As Workbook, ws As Worksheet

    Set wb = Workbooks.Open("C:\Temp\Documents Page XX_US-VC Combo Template.xlsx")

    Set ws = wb.Sheets(1)

    tbl.Range.Copy

    ws.Range("A1").Activate

    ws.Paste
End Sub

SCREENSHOT

Word Document

enter image description here

Excel (After Pasting)

enter image description here

Hope this helps.

Hey Siddharth, thanks alot for that. Ill i'mplement it in my code and get back to you.... — user1643371, Sep 03 '12 at 13:27
@SathishKothandam: Thanks for taking time to appreciate it :) — Siddharth Rout, Sep 23 '13 at 15:11

How to preserve source formatting while copying data from word table to excel sheet using VB macro?

Kindly let me know how I can edit this so as to preserve source formatting.

1 Answers1

Linked