VBA - Word Document to Excel Spreadsheet.

Posted on 2011-04-26
Last Modified: 2012-05-11
I have quite a few Word Documents that I need to export into Excel Spradsheets for easier input into a database. I am not very familiar with VBA.

All the Word Documents are identical to the one attached. The Excel Spreadsheet would need the "Monitoring Point I.D." as the Key field, and the table as the remaining data. There is a seperate sheet for each Monitoring ID.
Question by:GravitaZ24
    LVL 76

    Accepted Solution

    Not sure if this is what you need. It is Word VBA macro code
    Sub TablesToExcel()
        Dim xlApp As Excel.Application
        Dim xlWbk As Excel.Workbook
        Dim xlWks As Excel.Worksheet
        Dim tbl As Word.Table
        Dim r As Integer
        Dim c As Integer
        Dim t As Integer
        Dim strMonitorintPointID As String
        Set xlApp = New Excel.Application
        Set xlWbk = xlApp.Workbooks.Add
        xlApp.Visible = True
        Set xlWks = xlWbk.Sheets(1)
        t = 2
        Do Until t > ActiveDocument.Tables.Count
            If xlWbk.Sheets.Count < t / 2 Then
                Set xlWks = xlWbk.Sheets.Add
                Set xlWks = xlWbk.Sheets(t / 2)
            End If
            Set tbl = ActiveDocument.Tables(t)
            strMonitorintPointID = tbl.Cell(1, 2).Range.Fields(1).Result
            xlWks.Name = strMonitorintPointID
            Set tbl = ActiveDocument.Tables(t - 1)
            xlWks.Cells(1, 1).Value = "Monitoring Point I.D"
            For c = 1 To tbl.Columns.Count 'startcolumn to end column
                xlWks.Cells(1, c + 1).Value = GetCellText(tbl.Cell(1, c))
            Next c
            r = 2
            Do While True
                If Asc(tbl.Cell(r, 1).Range.Fields(1).Result) = 32 Then
                    Exit Do
                End If
                xlWks.Cells(r, 1).Value = strMonitorintPointID
                For c = 1 To tbl.Columns.Count
                    xlWks.Cells(r, c + 1).Value = tbl.Cell(r, c).Range.Fields(1).Result
                Next c
                r = r + 1
            t = t + 2
    End Sub
    Function GetCellText(cl As Cell) As String
        Dim rng As Range
        Set rng = cl.Range
        rng.MoveEnd wdCharacter, -1 'drop cell formatting
        GetCellText = rng.Text
    End Function

    Open in new window

    LVL 6

    Expert Comment

    Nice code!

    If you are not familiar with VBA, you need to know that the above code will only work if you add the Excel reference library.
    When you're in the Visual Basic window, select "Tools" and then "References...".
    Put a mark in "Microsoft Excel 12.0 Object Library" and click "OK".

    The reason why you need to do this is that it uses Excel-specific code, and in order to access that code library, you need to enable it this way.

    LVL 76

    Expert Comment

    Thanks scifo_dk.

    Yes that method is called early binding. It is much easier for development and slightly faster to run, but might have compatibility issues between different releases.

    The alternative is called late binding, for which to code would be the same except for the first three lines, which would become:

        Dim xlApp As Object
        Dim xlWbk As Object
        Dim xlWks As Object

    Author Comment

    Thank You guys so much! I seem to be getting an error though. Most likely something I'm doing wrong

    Author Comment

    It seems to be running perfectly and filling the sheets one at a time, but then that error pops up
    LVL 6

    Assisted Solution

    From what I can tell, it looks like it is trying to rename a sheet in the excel workbook to the same name as another sheet.
    Are there duplicates in the "Monitoring Point I.D." word-file?
    LVL 76

    Expert Comment

    To check, try commenting out line24:

          ' xlWks.Cells(1, 1).Value = "Monitoring Point I.D"

    Author Comment

    Yes, Thank you that was the problem! One of the Point ID's was identical. Thanks Everyone for the help!

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    How to run any project with ease

    Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
    - Combine task lists, docs, spreadsheets, and chat in one
    - View and edit from mobile/offline
    - Cut down on emails

    A few years ago I was very much a beginner at VBA, and that very much remains the case today.  I'll do my best to explain things as I go in the hope that other beginners can follow.  If you just want to check out a tool that creates a Select Case fu…
    This article describes how to use the Send to Mail Recipient command. The instructions apply generally to Office 2007 and later versions, but Microsoft® Word 2013 was used for the specific steps and figures.  What is Send to Mail Recipient? Send…
    This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
    This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

    779 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    14 Experts available now in Live!

    Get 1:1 Help Now