VBA Word Pasting Question

Is there a way using VBA to extract say Lines 1-200,000 in a Word document and paste it into Excel.

Thanks.
bcsmessAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

fanpagesCommented:
Was there a problem with my code in your previous question (# 21476447)?

I posted another comment this morning for clarification...

http://www.experts-exchange.com/Programming/Q_21476447.html
fanpagesCommented:
:)

Sorry... just noticed you have replied.

OK, we'll carry on here, if you wish to close/grade the other question.

Thanks.
fanpagesCommented:
"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..."

So, fill lines from  Word from A1 to A5, then F1:F5, then K1:K5?

Sorry... I'm still not 100% on what you are looking for as a result.

Perhaps an example pasted in a reply would be useful?

BFN,

fp.
Your Guide to Achieving IT Business Success

The IT Service Excellence Tool Kit has best practices to keep your clients happy and business booming. Inside, you’ll find everything you need to increase client satisfaction and retention, become more competitive, and increase your overall success.

bcsmessAuthor Commented:
so I probably have about 200,000 lines in word to extract.  I'd like to run your program to fill Col. A as much as possible which would be 65536 rows max, then start pasting at row 1 5 columns over in Col. F until column F is full, and then start pasting at row 1 5 col. over in Col. K until K is full and so on until all my data has been pasted.

Thanks.
fanpagesCommented:
Hi,

Please try these amendments...

Option Explicit
Public Function strGet_Lines_From_Word_Document(ByVal strDocument As String, _
                                                Optional ByVal lngLines As Long = 0&) As String
                                             
' --------------------------------------------------------------------------------------------
' Experts Exchange
'
' Question Channel: Home/All Topics/Programming
' Question Title:   VBA Word Pasting Question
' Question Asker:   bcsmess
' Question Dated:   1 July 2005 02:20PM BST
' Question URL:     http://www.experts-exchange.com/Programming/Q_21477518.html
'
' Expert Comment:   "fanpages"
' Copyright:        (c) 2005 Clearlogic Concepts (UK) Limited / N.Lee [ http://NigelLee.info ]
'
' See Also:         Extract Word Lines into Excel
'                   30 June 2005 04:38PM BST
'                   http://experts-exchange.com/Programming/Q_21476447.html
' --------------------------------------------------------------------------------------------
               
  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
 
  If lngLines > 0& Then                                 ' Note: Long data type stores up to 2,147,483,647
     objWord_Application.Selection.MoveDown Unit:=wdLine, Count:=lngLines, Extend:=wdExtend
  Else
     objWord_Application.Selection.WholeStory
  End If
 
  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:   VBA Word Pasting Question
' Question Asker:   bcsmess
' Question Dated:   1 July 2005 02:20PM BST
' Question URL:     http://www.experts-exchange.com/Programming/Q_21477518.html
'
' Expert Comment:   "fanpages"
' Copyright:        (c) 2005 Clearlogic Concepts (UK) Limited / N.Lee [ http://NigelLee.info ]
'
' See Also:         Extract Word Lines into Excel
'                   30 June 2005 04:38PM BST
'                   http://experts-exchange.com/Programming/Q_21476447.html
' --------------------------------------------------------------------------------------------

  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", 200000)  ' Remove last parameter for all lines in file
 
  While (Len(Trim$(strText)) > 0)
 
      intPos = InStr(strText & vbCr, vbCr)
     
      objCell = Left$(strText, intPos - 1)
     
      If objCell.Row = 65536 Then
         If objCell.Column + 5 <= 256 Then
            Set objCell = Cells(1&, objCell.Column + 5)
         Else
            strText = ""                                ' Force end of While...Wend loop
         End If
      Else
         Set objCell = objCell.Offset(1&)
      End If
     
      strText = Mid$(strText, intPos + 2)               ' Changed from "intPos + 1"
     
  Wend
 
End Sub
Public Sub Test()

  Call Get_Lines_From_Word_Document([A1])
 
End Sub


BFN,

fp.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
fanpagesCommented:
Thanks for your grading.

Happy codin',

BFN,

fp.
[ http://NigelLee.info ]
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Programming

From novice to tech pro — start learning today.