Copy from Word and paste into Excel!!!!

[dkelb]

I am a newbie to VBA........
I have a word document that is composed of many pages with text. I
want to find the first occurance of "Objective" and copy the text
that
follows then paste it into A1. Find the next occurance and past it
into A2. Do this until the end of the word file. Then find the first
occurance of "Date" and copy the text that follows then paste it into
B1. Find the next occurance and paste it into B2. Do this until the
end of the word file.




Thanks in advance for some VBA code for Excel that can save me tons
of
time!

[angel angel]

Take sample word file save it as.
D:\Test\sample.doc
Similarly
D:\Test\Book1.xls

Now open Sample.doc
go to
Tools-->Macro-->Visual Basic Editor-->Module-->Insert-->Module

Now paste code as it is....

Option Explicit
Option Base 1
Sub WordDataToExcel()
Dim myObj
Dim myWB
Dim mySh
Dim txt As String, Lgth As Long, Strt As Long
Dim i As Long
Dim oRng As Range
Dim Tgt As String
Dim TgtFile As String
Dim arr()
Dim ArrSize As Long
Dim ArrIncrement As Long
ArrIncrement = 1000
ArrSize = ArrIncrement
ReDim arr(ArrSize)

'Set parameters Change to your path and filename
TgtFile = "Book1.xls"
If IsWindowsOS Then
Tgt = "D:\TEST" & TgtFile ' Windows OS
Else
Tgt = "MacintoshHD:Users:ronald:Destop:" & TgtFile 'Mac OS
End If
txt = InputBox("String to find")
Lgth = InputBox("Length of string to return")
Strt = Len(txt)

'Return data to array
With Selection
.HomeKey unit:=wdStory
With .Find
.ClearFormatting
.Forward = True
.Text = txt
.Execute
While .Found
i = i + 1
Set oRng = ActiveDocument.Range _
(Start:=Selection.Range.Start + Strt, _
End:=Selection.Range.End + Lgth)
arr(i) = oRng.Text
oRng.Start = oRng.End
.Execute
If i = ArrSize - 20 Then
ArrSize = ArrSize + ArrIncrement
ReDim Preserve arr(ArrSize)
End If
Wend
End With
End With
ReDim Preserve arr(i)

'Set target and write data
Set myObj = CreateObject("Excel.Application")
Set myWB = myObj.workbooks.Open(Tgt)
Set mySh = myWB.sheets(1)
With mySh
.Range(.Cells(1, 1), .Cells(i, 1)) = myObj.transpose(arr)
End With

'Tidy up
myWB.Close True
myObj.Quit
Set mySh = Nothing
Set myWB = Nothing
Set myObj = Nothing
End Sub

Public Function IsWindowsOS() As Boolean
If Application.System.OperatingSystem Like "*Win*" Then
IsWindowsOS = True
Else
IsWindowsOS = False
End If
End Function

> --
> You received this message because you are subscribed to the Google Groups
> "MS Excel Macro Vba" group.
> To post to this group, send email to exce...@googlegroups.com.
> To unsubscribe from this group, send email to
> excel_vba+...@googlegroups.com.
> For more options, visit this group at
> http://groups.google.com/group/excel_vba?hl=en.
>
>

[Brigitte Bon..]

Hi,

First add the Excel Library (Microsoft Excel 11.0 Object Library) to
your project.

(Menu -> Tools-> References)

Then copy and paste the following code in Ms Word's Module.

Public Sub ParagraphIterator()

Dim myXL As Excel.Application 'err is here !!!

'Excel.Application

Dim iParagraph As Paragraph

Dim iCounter As Long

Set myXL = New Excel.Application

myXL.Workbooks.Add

iCounter = 0

For Each iParagraph In ActiveDocument.Paragraphs

iCounter = iCounter + 1

myXL.ActiveWorkbook.Worksheets(1).Range("A" & iCounter).Value =
iParagraph.Range.Text

Next iParagraph

MsgBox "Contents will be exported to C:\Test.xls"
myXL.ActiveWorkbook.SaveAs "c:\Test.xls"

myXL.Quit

Set myXL = Nothing

End Sub