COPY FROM WORD TO EXCEL

[purplej]

Hi guys,

I have a excel file which has got list of file name in column A2 onwards, I would like a macro which can open each of these word file and copy last 5 rows and last paste them in excel in B2 onwards.

the word files are store in individual folder which is based on first 3 charters of the file name. So for example if the file name is ABC123, this file will be under the folder ABC and so on...

[purplej]

I have found the below code which does what I need but only 1 document at time and get all the lines in form. Can someone help me to modify this so it only pick last 3 lines from the word file and loops for each file?


Option Explicit
Private fileToOpen As String
Private Sub cmdClear_Click()
Me.txtWordDoc.Text = ""
End Sub
Private Sub txtWordDocPath_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Me.txtWordDocPath <> "" And (fileToOpen = "" Or fileToOpen = "False") Then
fileToOpen = Me.txtWordDocPath
End If
End Sub
Private Sub cmdBrowse_Click()
fileToOpen = Application.GetOpenFilename("Word Files (*.doc), *.doc", , "GetWordDoc")
If fileToOpen <> "False" And fileToOpen <> "" Then
Me.txtWordDocPath = fileToOpen
End If
End Sub
Private Sub cmdGetWord_Click()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'--You can use these declares if you have references set for Word
' Dim wrdApp As Word.Application
' Dim wrdDoc As Word.Document

'--Otherwise use these declares
Dim wrdApp As Object
Dim wrdDoc As Object
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'exit if no document was selected
If fileToOpen = "False" Or fileToOpen = "" Then Exit Sub

'startup word
Set wrdApp = CreateObject("Word.Application")

'Comment out this line to hide word from the user
wrdApp.Visible = True
'open the selected document
Set wrdDoc = wrdApp.Documents.Open(fileToOpen)

'select the entire document
wrdApp.Selection.WholeStory
wrdApp.Selection.Copy

'paste word document text to textbox
Me.txtWordDoc.SetFocus
'select contents of textbox to be overwritten
Me.txtWordDoc.SelStart = 0
Me.txtWordDoc.SelLength = Me.txtWordDoc.TextLength
'paste in word doc contents
Me.txtWordDoc.Paste
'reset cursor to the top of the textbox
Me.txtWordDoc.SelStart = 0
Me.txtWordDoc.SelLength = 0

'close and clean up word objects
wrdDoc.Close
Set wrdDoc = Nothing
wrdApp.Quit
Set wrdApp = Nothing
End Sub