Extract Word Lines into Excel

Are you looking for VBA code that runs in Excel, opens a word document, and extracts the lines,...
or...
VBA code that runs in Word, extracts text from the current document, and then opens MS-Excel & creates a new workbook
?

the first one:  VBA code that runs in Excel, opens a word document, and extracts the lines,...

Where in Excel would you like the lines pasted?

Starting at a Cell, e.g. A1, and increasing a row for every line, or all 100 lines into one cell?

increasing a row for every line.

Ok, thanks.

Open your MS-Excel workbook file (as normal).
Note: it's "safer" to have just this file open for clarity in the following steps.

Click [ALT]+[F11] (hold down [ALT], press [F11], release [F11], release [ALT]) to show the "Microsoft Visual Basic" environment window.

Press [CTRL]+[R] (hold down [CTRL]... etc as above) to show the "Project" window if not already shown.

Locate the entry for "VBAProject (Book1)".

Right-click it, and select "Insert ->" / "Module" the following block of text into the code window that opens:

' Start of code...

Option Explicit
Public Function strGet_Lines_From_Word_Document(ByVal strDocument As String, _
                                                Optional ByVal lngLines As Long = 100&) As String
                                             
' --------------------------------------------------------------------------------------------
' Experts Exchange
'
' Question Channel: Home/All Topics/Programming
' Question Title:   Extract Word Lines into Excel
' Question Asker:   bcsmess
' Question Dated:   30 June 2005 04:38PM BST
' Question URL:     https://www.experts-exchange.com/questions/21476447/Extract-Word-Lines-into-Excel.html
'
' Expert Comment:   "fanpages"
' Copyright:        (c) 2005 Clearlogic Concepts (UK) Limited / N.Lee [ http://NigelLee.info ]
' --------------------------------------------------------------------------------------------
                                             
  Dim objWord_Application                               As Object
  Dim strReturn                                         As String
 
  On Error GoTo Err_strGet_Lines_From_Word_Document
 
  Const wdExtend                                        As Long = 1&
  Const wdLine                                          As Long = 5&
 
  Set objWord_Application = CreateObject("Word.Application")
 
  objWord_Application.Documents.Open strDocument
  objWord_Application.Selection.MoveDown Unit:=wdLine, Count:=lngLines, Extend:=wdExtend
 
  strReturn = objWord_Application.Selection.Text
 
Exit_strGet_Lines_From_Word_Document:

  On Error Resume Next
 
  If Not (objWord_Application Is Nothing) Then
     objWord_Application.ActiveDocument.Close
     objWord_Application.Quit
     Set objWord_Application = Nothing
  End If
 
  strGet_Lines_From_Word_Document = strReturn
 
  Exit Function
   
Err_strGet_Lines_From_Word_Document:

  MsgBox "Error #" & CStr(Err.Number) & vbCrLf & vbLf & Err.Description, _
          vbExclamation Or vbOKOnly, _
          ActiveWorkbook.Name
         
  strReturn = "Error #" & CStr(Err.Number) & " - " & Err.Description
 
  Resume Exit_strGet_Lines_From_Word_Document
         
End Function
Public Sub Get_Lines_From_Word_Document(Optional ByRef objCell As Range = Nothing)

' --------------------------------------------------------------------------------------------
' Experts Exchange
'
' Question Channel: Home/All Topics/Programming
' Question Title:   Extract Word Lines into Excel
' Question Asker:   bcsmess
' Question Dated:   30 June 2005 04:38PM BST
' Question URL:     https://www.experts-exchange.com/questions/21476447/Extract-Word-Lines-into-Excel.html
'
' Expert Comment:   "fanpages"
' Copyright:        (c) 2005 Clearlogic Concepts (UK) Limited / N.Lee [ http://NigelLee.info ]
' --------------------------------------------------------------------------------------------

  Dim intPos                                            As Integer
  Dim strText                                           As String
 
  On Error Resume Next
 
  If (objCell Is Nothing) Then
     Set objCell = Range("A1")
  End If
 
  strText = strGet_Lines_From_Word_Document("c:\word.doc", 100&)
 
  While (Len(Trim$(strText)) > 0)
 
      intPos = InStr(strText & vbCr, vbCr)
     
      objCell = Left$(strText, intPos - 1)
     
      Set objCell = objCell.Offset(1&)
     
      strText = Mid$(strText, intPos + 1)
     
  Wend
 
End Sub
Public Sub Test()

  Call Get_Lines_From_Word_Document([A1])
 
End Sub

' ...End of code

Use [ALT]+[F11] again to return to the main MS-Excel view.

Save the workbook.


To run the code, use the [ALT]+[F8] key combination (or select "Tools" / "Macro" from the menu bar).

Locate the "macro" name "Test" in the list shown and then double-click it, or click the [Run] button.


Note: The code assumes your MS-Word document is called "c:\word.doc" - obviously you'll need to change this to match the document you wish to read from.

BFN,

fp.

that was really impressive.  two quick things i was wondering was possible:  

1: in each cell after the first, a return space is added before every line in the cell.  What's the best way to take that extra line space out?
2: i may have more than 65536 rows allowed by Excel.  Where can I add an iterative counter that once it hits a number before that, the loop repeats in the first row of  a new column and so on for the remaining data?

Thank you so much and I will create another question to give you double the points as this seems like a lot of work.

i posted a new question here:

https://www.experts-exchange.com/questions/21477518/VBA-Word-Pasting-Question.html

but yes, for number 2, that is what i mean, except the minor change is that i wish to place the data in col. A, then 5 lines over into Col F, then 5 lines over into Col K...

Part #1 is fixed.

Thanks!

Thanks also for the grading.

We'll continue discussions in the other question.

:)