Ray.Mason
10-21-2011, 01:37 PM
Hi,
I need to copy text from a number of word documents onto excel template and I'm stuck when it comes to selecting text in word document and placing into specific cell in excel.
The source document (word) has some text outside tables and some within tables.
eg
Table Title
CellA CellB CellC
Row1
Row2
Row 3
I want to copy table title to excel cell F2
Then word table cell A1 to excel cell F3
...word table cell B1 to excel F4 upto F94
Then..another table title and table contents to end of document.
Save excel template and close
I so far have the following code which doesn't do much apart from opening source doc and excel template:
Sub WordToExcel()
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
SaveFolder = "C:\Users\*\Desktop\*\"
mypath = "C:\Users\*\Desktop\*\"
FName = Dir(mypath & "*.dot")
Do While Len(FName) > 0
Set wdDoc = Word.Documents.Open(mypath & FName)
'Copy content
Set oBook = Application.Workbooks.Open("C:\Users\*\Desktop\*")
'insert into sheet1, cells F2 to F94
SaveName = SaveFolder + FName + ".doc"
myDoc.SaveAs (SaveName)
myDoc.Close
wdDoc.Close savechanges:=False
FName = Dir ' get next file
Loop
End Sub
I need to copy text from a number of word documents onto excel template and I'm stuck when it comes to selecting text in word document and placing into specific cell in excel.
The source document (word) has some text outside tables and some within tables.
eg
Table Title
CellA CellB CellC
Row1
Row2
Row 3
I want to copy table title to excel cell F2
Then word table cell A1 to excel cell F3
...word table cell B1 to excel F4 upto F94
Then..another table title and table contents to end of document.
Save excel template and close
I so far have the following code which doesn't do much apart from opening source doc and excel template:
Sub WordToExcel()
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
SaveFolder = "C:\Users\*\Desktop\*\"
mypath = "C:\Users\*\Desktop\*\"
FName = Dir(mypath & "*.dot")
Do While Len(FName) > 0
Set wdDoc = Word.Documents.Open(mypath & FName)
'Copy content
Set oBook = Application.Workbooks.Open("C:\Users\*\Desktop\*")
'insert into sheet1, cells F2 to F94
SaveName = SaveFolder + FName + ".doc"
myDoc.SaveAs (SaveName)
myDoc.Close
wdDoc.Close savechanges:=False
FName = Dir ' get next file
Loop
End Sub