word to excel
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
|