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