I found some macro in my archieves, but not sure if I ever got them
fully running. You are welcomed to try them

Sub Test()
Set ExSht = ActiveSheet
'
FName = "c:\temp\abc.doc"
WordWasRunning = True

On Error Resume Next
Set WDApp = GetObject(, "Word.Application")
If Err.Number < 0 Then
Set WDApp = CreateObject("Word.Application")
WordWasRunning = False
End If

WDApp.Visible = True 'at least for testing!

Set WDDoc = WDApp.documents.Open(Filename:=FName)
RowCount = 1
For Each Table In WDDoc.tables
For Each rw In Table.Rows
ColCount = 1
For Each Cell In rw.Cells

Set rngtext = Cell.Range
rngtext.MoveEnd Unit:=wdCharacter, Count:=-1
ExSht.Cells(RowCount, ColCount) = rngtext
ColCount = ColCount + 1
Next Cell
RowCount = RowCount + 1
Next rw
Next Table
Set WordTable = WDDoc.tables(1)
WDDoc.Close
WDApp.Quit
End Sub


Sub Test()
Set ExSht = ActiveSheet
'
FName = "c:\temp\abc.doc"
WordWasRunning = True

On Error Resume Next
Set WDApp = GetObject(, "Word.Application")
If Err.Number < 0 Then
Set WDApp = CreateObject("Word.Application")
WordWasRunning = False
End If

WDApp.Visible = True 'at least for testing!

Set WDDoc = WDApp.documents.Open(Filename:=FName)
RowCount = 1
For Each Table In WDDoc.tables
Table.Copy
ExSht.Range("A1").Paste
Next Table

WDDoc.Close
WDApp.Quit
End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?u=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=197465

http://www.thecodecage.com/forumz