We are looking for an automated way to convert tables found in a word
document into an excel spreadsheet.
The word files are the output of our OCR program.
The answer should be a script that can be in any programming language
including VBA.
Sample data to test can be found at:
http://www.nohlnet.de/ocr_sample.doc

---

Request for Question Clarification by rainbow-ga on 28 Feb 2006 13:05 PST

Hi honk98,

Please follow these directions (Method 1) and let me know if it works
for you. I tested it and converted the sample document you provided
into an excel spreadsheet.

http://support.microsoft.com/?kbid=243275

Looking forward to your clarification.

Best regards,
Rainbow

---

Clarification of Question by honk98-ga on 28 Feb 2006 14:38 PST

Hi Rainbow,

thanks a lot for your suggestion. Unfortunately my version of Word
(2003) does not provide the option of saving to *.ans
The second descibed method - saving to txt - doesnt really work either.

Thanks again,
     
    -honk98

---

Request for Question Clarification by rainbow-ga on 28 Feb 2006 14:46 PST

I have Word 2003 too and it worked with me. 

In the Save As dialog box, change the Save as type box to "Text with
Layout", This will automatically save it as *.ans.


Best regards,
Rainbow

---

Clarification of Question by honk98-ga on 01 Mar 2006 15:52 PST

Rainbow,

After installing an old Word version in addition to Word 2003 I can
use the "text with layout" output filter.
Unfortunately this converts only one table at a time.
I need an automated way to convert hundreds of tables.
Thanks a lot for the suggestion, though.

Hi honk98,

Hav a look to the VBA code (Word) below which converts Word tables into Excel file.
It's not perfect...but it's the best solution i find.

Create a new Word document.
Tools -> Marcos -> Visual BASIC Editor
Paste the code below
Tools -> Reference -> Select Microsoft Excel 110 object library
Save your new document

To convert a file:
Tools -> Macros -> Macros -> WordToExcel.
The cells of your Word document which could be converted are gray, the
others still white.

Best regards,
MrBzzT

-------------------------------------------------

Option Explicit

Sub WordToExcel()

Dim objExcel            As Excel.Application
Dim Wkb                 As Excel.Workbook

Dim WdCol, WdRow        As Integer
Dim XlRow               As Integer
Dim idTable             As Table
Dim idCell              As Cell
Dim idShape             As Shape
Dim NbTable             As Integer

Dim Ret                 As Variant

'Open Doc document
With Dialogs(wdDialogFileOpen)
   .Name = "*.doc"
   Ret = .Show
End With
If Ret <> -1 Then Exit Sub

Application.ScreenUpdating = False
Application.DisplayStatusBar = True

For Each idShape In ActiveDocument.Shapes
   If idShape.Type = msoTextBox Then idShape.ConvertToFrame
Next

'Init.
XlRow = 0
NbTable = 0

'Create new Workbook in Excel
Set objExcel = CreateObject("Excel.Application")
Set Wkb = objExcel.Workbooks.Add(xlWBATWorksheet)
Wkb.ActiveSheet.Cells.NumberFormat = "@"

'For each table in current document
For Each idTable In ActiveDocument.Tables
   WdRow = 1
   WdCol = 1
   NbTable = NbTable + 1
   Application.StatusBar = "Convert table " & NbTable & "/" &
ActiveDocument.Tables.Count
   'Copy each cell in XL Workbook
   Do
      Wkb.ActiveSheet.Cells(XlRow + WdRow, WdCol).Formula =
CharCleaner(idTable.Cell(WdRow, WdCol).Range.Text)
      idTable.Cell(WdRow, WdCol).Shading.BackgroundPatternColor = wdColorGray15
      If Not (idTable.Cell(WdRow, WdCol).Next Is Nothing) Then
         Set idCell = idTable.Cell(WdRow, WdCol).Next
         WdRow = idCell.RowIndex
         WdCol = idCell.ColumnIndex
      Else
         Exit Do
      End If
   Loop
   XlRow = XlRow + WdRow + 1
Next

objExcel.ActiveSheet.Cells.AutoFit
objExcel.Visible = True

Application.ScreenUpdating = True
Application.StatusBar = True

End Sub



Private Function CharCleaner(Text As String)

Dim i As Integer

For i = 1 To Len(Text) - 2
   If Asc(Mid(Text, i, 1)) >= 32 Or Mid(Text, i, 1) = vbCr Then
      If Mid(Text, i, 1) = vbCr Then
         CharCleaner = CharCleaner & vbLf
      Else
         CharCleaner = CharCleaner & Mid(Text, i, 1)
      End If
   End If
Next

End Function