Storing data from a worksheet embedded in MS Word - excel

Question

I am new to this board. I have searched through past answers to various questions related to mine but have not succeeded in finding a solution to my problem.
What I need to do is:
1) Using vba/vb within an Excel doc, locate an Excel spreadsheet which is embedded in a Word doc.
2) Read data from its cells.
3) Store that data in the cells of the current Excel doc.
I have been able to locate the embedded Excel spreadsheet but can't see how to get it's data into the current spreadsheet's cells. Here's the code by which I have located the embedded spreadsheet:
Sub GetWordata()
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
Dim singleLine As Paragraph
Dim lineText As String
Dim word_app As word.Application
Dim wDoc As word.Document
Dim r As Integer
Dim i As Long, Rng As Range
Dim Evalue As String
.
.
.
With activeDocument
For i = .InlineShapes.Count To 1 Step -1
With .InlineShapes(i)
If Not .OLEFormat Is Nothing Then
If Split(.OLEFormat.ClassType, ".")(0) = "Excel" Then
MsgBox "Excel File"
End If
End If
End With
Next
End With
The message box in the code above displays, indicating that I have located the embedded spreadsheet.
Thanks ahead for any help.

Answer 1

This will import data from all tables in all Word files in a folder. This is just a small sample of what can be done with COM for Word and Excel (run the code from Excel).
Sub WordToExcel()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim x As Integer
Dim strFilename As String
Dim strFolder As String
Dim temp As String
Set wdApp = New Word.Application
'initialise counter
x = 1
'search for first file in directory
strFolder = "C:\test\"
strFilename = Dir(strFolder & "*.doc")
'amemd folder name
Do While strFilename <> ""
Set wdDoc = wdApp.Documents.Open(strFolder & strFilename)
temp = wdDoc.Tables(1).Cell(2, 1).Range.Text 'read word cell
Range("A2").Offset(x, 0) = temp
temp = wdDoc.Tables(1).Cell(2, 2).Range.Text 'read word cell
Range("A2").Offset(x, 1) = temp
'etc
temp = wdDoc.Tables(1).Cell(2, 3).Range.Text 'read word cell
Range("A2").Offset(x, 2) = temp
temp = wdDoc.Tables(1).Cell(2, 4).Range.Text 'read word cell
Range("A2").Offset(x, 3) = temp
wdDoc.Close
x = x + 1
strFilename = Dir
Loop
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub