Sorry, I meant copy the table from Word, then paste directly into Excel. Cheers

"JimmyA" wrote:

Thanks Jacob. Is there any way of copying the whole table at once and then
pasting into Word?

"Jacob Skaria" wrote:

Dir() command returns only the file name...You should supply the path name
separately. Try the below.....

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:\Documents and Settings\rafflej\Desktop\loads\"
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

wdDoc.Close
x = x + 1
strFilename = Dir
Loop
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub


--
Jacob (MVP - Excel)


"JimmyA" wrote:

Hi

I need help importing tables from word to excel. There are c. 200 files in a
folder with the same table layout. I found the the code below on a different
thread but it keeps crashing as it says it can't find the file (but it is
there!):

Sub WordToExcel()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim x As Integer
Dim strFilename As String
Dim temp As String

Set wdApp = New Word.Application
'initialise counter
x = 1
'search for first file in directory
strFilename = Dir("C:\Documents and Settings\rafflej\Desktop\loads\*.doc")
'amemd folder name
Do While strFilename < ""
Set wdDoc = wdApp.Documents.Open(strFilename) // BREAKS DOWN HERE
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


wdDoc.Close
x = x + 1
strFilename = Dir
Loop
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub

Thanks Guys