?
Solved

VBA - Word Document to Excel Spreadsheet.

Posted on 2011-04-26
8
Medium Priority
?
599 Views
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.
Mod-08-Att-8.13A-Springs.docx
0
Comment
Question by:GravitaZ24
  • 3
  • 3
  • 2
8 Comments
 
LVL 76

Accepted Solution

by:
GrahamSkan earned 1600 total points
ID: 35468756
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
        Else
            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
        Loop
        t = t + 2
    Loop
    'xlWbk.Close
    'xlApp.Quit
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

0
 
LVL 6

Expert Comment

by:scifo_dk
ID: 35468907
GrahamSkan:
Nice code!

Gravitaz24:
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.

//Scifo_dk
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 35469200
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
0
Veeam Disaster Recovery in Microsoft Azure

Veeam PN for Microsoft Azure is a FREE solution designed to simplify and automate the setup of a DR site in Microsoft Azure using lightweight software-defined networking. It reduces the complexity of VPN deployments and is designed for businesses of ALL sizes.

 

Author Comment

by:GravitaZ24
ID: 35469233
Thank You guys so much! I seem to be getting an error though. Most likely something I'm doing wrong
 Error
0
 

Author Comment

by:GravitaZ24
ID: 35469242
It seems to be running perfectly and filling the sheets one at a time, but then that error pops up
0
 
LVL 6

Assisted Solution

by:scifo_dk
scifo_dk earned 400 total points
ID: 35469402
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?
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 35469849
To check, try commenting out line24:

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

Author Comment

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

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Quickbooks hosting can do wonders to your enterprise but considering the points elaborated in the article which will help you to better analyze the outcomes. So scan your business, its needs and then move to the new world of limitless benefits.
In a use case, a user needs to close an opened report by simply pressing the Escape (Esc) key. This can be done by adding macro code in Report_KeyPress or Report_KeyDown event.
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…

850 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