Consulting

Results 1 to 7 of 7

Thread: Copying tables from word to excel incl. formatting

  1. #1

    Copying tables from word to excel incl. formatting

    Hi, I'm new in VBA, so bear with me!

    I'm trying to extract data from 13 tables I have in a word-doc.
    Via google and other sites, I figured out how to extract all data from the tables. However, I would like to keep the formatting, as there is both bold-font, and bullets in the word-document.
    Can anyone help me with this? Basically it would be to copy/paste all tables manually from word to excel including the formatting.

    My code right now is this:


    Option Explicit
    
    Sub ImportWordTable()
    
    
    Dim wdDoc As Object
    Dim wdFileName As Variant
    Dim TableNo As Integer      'table number in Word
    Dim iRow As Long            'row index in Excel
    Dim iCol As Integer         'column index in Excel
    Dim resultRow As Long
    Dim tableStart As Integer
    Dim tableTot As Integer
    
    
    On Error Resume Next
    
    
    wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
    "Browse for file containing table to be imported")
    
    
    If wdFileName = False Then Exit Sub '(user cancelled import file browser)
    
    
    ActiveSheet.Range("A:AZ").ClearContents
    
    
    Set wdDoc = GetObject(wdFileName) 'open Word file
    
    
    With wdDoc
        TableNo = wdDoc.Tables.Count
        tableTot = wdDoc.Tables.Count
        If TableNo = 0 Then
            MsgBox "This document contains no tables", _
            vbExclamation, "Import Word Table"
        ElseIf TableNo > 1 Then
            TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
            "Enter the table to start from", "Import Word Table", "1")
        End If
    
    
        resultRow = 1
    
    
        For tableStart = TableNo To tableTot
            With .Tables(tableStart)
                'copy cell contents from Word table cells to Excel cells
                For iRow = 1 To .Rows.Count
                    
                    For iCol = 1 To .Columns.Count
                        Cells(resultRow, iCol) = .cell(iRow, iCol).Range.Text
                    Next iCol
                    resultRow = resultRow + 1
                Next iRow
            End With
            resultRow = resultRow + 1
        Next tableStart
        
    
    
    End With
    
    
    
    
    End Sub

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Copying Word tables to Excel has a number of problems, including that Word cells with multiple paragraphs become separate rows when pasted into Excel and columns in Word tables can have varying cell widths - which Excel doesn't support. That said, see, for example: https://www.excelguru.ca/forums/show...ll=1#post36586
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    404
    Location
    A simple version. But I do not know whether effective.
    Sub ImportWordTable_1()
    
        Dim wdDoc       As Object
        Dim wdFileName  As Variant
        Dim TableNo     As Integer
        Dim iRow        As Long
        Dim resultRow   As Long
        Dim tableStart  As Integer
        Dim tableTot    As Integer
    
    
    
    
        'On Error Resume Next
    
    
    
    
        wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
                                                 "Browse for file containing table to be imported")
    
    
    
    
        If wdFileName = False Then Exit Sub    '(user cancelled import file browser)
    
    
        ActiveSheet.Range("A:AZ").Clear
    
    
        Set wdDoc = GetObject(wdFileName)    'open Word file
    
    
    
    
        With wdDoc
            
            TableNo = wdDoc.Tables.Count
            tableTot = wdDoc.Tables.Count
            
            If TableNo = 0 Then
                MsgBox "This document contains no tables", _
                       vbExclamation, "Import Word Table"
            ElseIf TableNo > 1 Then
                TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
                                   "Enter the table to start from", "Import Word Table", "1")
            End If
    
    
            resultRow = 1
    
    
            For tableStart = TableNo To tableTot
                
                With .Tables(tableStart)
                    .Range.Copy
                    iRow = .Rows.Count
                End With
    
    
                ActiveSheet.Cells(resultRow, 1).Select
                ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
                resultRow = resultRow + iRow
            Next tableStart
    
    
            .Close False 'close document
    
    
        End With
    
    
        Set wdDoc = Nothing
    
    
    End Sub
    Artik

  4. #4
    Thank you, that almost fixed my problem! :-)
    Now it just skips some of the rows!

  5. #5
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Cross-posted at: https://stackoverflow.com/questions/...ncl-formatting
    Please read VBA Express' policy on Cross-Posting - which you agreed to abide by when you signed up - in Rule 3: http://www.vbaexpress.com/forum/faq...._new_faq_item3
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  6. #6
    I don't know how I have posted two questions, but I also asked the one you are referring to

  7. #7
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Well, you asked the same question on two completely different forums. Kinda hard not to know you've done that - or how...
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •