Macro to copy text from Word to Excel

[pwyf]

Hi everyone,

I am working on several Word documents which look like this:
http://tof.canardpc.com/show/734b4b30-cba2-4be2-bcce-e280d3b46de3.html

Here is how each block of text is arranged:

Numbers tab Numbers Paragraph
Text Paragraph
Text Paragraph
Paragraph

I would like to import this data into Excel to make it look like this:
http://tof.canardpc.com/show/b65eef8a-783a-4ae6-a429-b4f09fd7d757.html

First column: first series of numbers
Second column: second series of numbers
Third column: First line of text(alt+return)Second line of text

I hope all of this is clear.

I have tried creating a macro on my own, but I don't know Visual Basic,
so I have failed miserably.

I either need a macro that will arrange the text so I can copy/paste it
to Excel easily, or one which will do everything by itself...

I need to do this on 40 documents which contain up to 100 blocks of text.

Thanks for your help!

pwyf

 

[Doug Robbins - Word MVP on news.microsoft.com]

If you put all of the documents in a folder by themselves and in the Visual
Basic Editor, from the Tools menu, you select References and then place a
checkmark in the box for the Microsoft Excel ##.0 Object Library (where the
## will depend on the version of Office that you are running), the following
macro will do what you want.

Dim fname As String
Dim PathToUse As String
Dim Target As Excel.Workbook
Dim Source As Document
Dim fd As FileDialog
Dim drange As Range
Dim strText As String
Dim i As Long, j As Long
Dim oXL As Excel.Application
Dim tSheet As Excel.Worksheet
Dim ExcelWasNotRunning As Boolean

'If Excel is running, get a handle on it; otherwise start a new instance of
Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")

If Err Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
End If

'On Error GoTo Err_Handler
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Select the folder containing the files."
If .Show = -1 Then
PathToUse = .SelectedItems(1) & "\"
Else
End If
End With
Set fd = Nothing
oXL.Visible = True
'Open the workbook
Set Target = oXL.Workbooks.Add
Set tSheet = Target.Sheets(1)

With tSheet
.Range("A1") = "Start"
.Range("B1") = "Finish"
.Range("C1") = "Text"
.Columns("C").ColumnWidth = 50
End With

If Len(PathToUse) = 0 Then
Exit Sub
End If
fname = Dir$(PathToUse & "*.doc")
j = 1
While fname <> ""
Set Source = Documents.Open(PathToUse & fname)
With Source
For i = 1 To .Paragraphs.Count
If IsNumeric(Left(.Paragraphs(i).Range.Text, 1)) Then
j = j + 1
strText = Left(.Paragraphs(i).Range.Text, 8)
tSheet.Range("A" & j) = strText
strText = Mid(.Paragraphs(i).Range, 10, 8)
tSheet.Range("B" & j) = strText
i = i + 1
Set drange = .Paragraphs(i).Range
drange.End = drange.End - 1
strText = drange.Text
i = i + 1
If Len(.Paragraphs(i).Range) > 0 Then
Set drange = .Paragraphs(i).Range
drange.End = drange.End - 1
strText = strText & vbLf & drange.Text
End If
tSheet.Range("C" & j) = strText
End If
Next i
End With
Source.Close wdDoNotSaveChanges
fname = Dir$()
Wend
tSheet.Cells.VerticalAlignment = xlTop

Set drange = Nothing
Set tSheet = Nothing
Set Target = Nothing
Set oXL = Nothing
Exit Sub

Err_Handler:
MsgBox Target & " caused a problem. " & Err.Description, vbCritical, _
"Error: " & Err.Number
If ExcelWasNotRunning Then
oXL.Quit
End If



--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[pwyf]

Hi Doug, and thanks for the reply.

I must say I'm a real newbie. I tried creating a new module with the VBA
editor and ran the macro that you gave me.

I got an error message saying: "Compilation error: Incorrect instruction
outside of a procedure" (my translation. I use Office in French).

When the error message appears, the word "Set" in "Set oXL = GetObject(,
"Excel.Application")" is selected.

Can you help?

Thanks again.

 

[Doug Robbins - Word MVP on news.microsoft.com]

You probably did not set the reference to the Microsoft Excel ##.0 Object
Library as mentioned at the beginning of my response.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[pwyf]

Hi Doug,

Actually I did. My version is 11.

pwyf

 

[Doug Robbins - Word MVP on news.microsoft.com]

You need the code that I gave you inside a

Sub MacroName()


End Sub

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[pwyf]

Hi Doug,

Thanks again for helping me.

Now I get an error message saying the macros are deactivated. I tried
looking it up in the Help section but couldn't find anything.

pwyf

 

[Doug Robbins - Word MVP on news.microsoft.com]

See the article "What do I do with macros sent to me by other newsgroup
readers to help me out?" at:

http://www.word.mvps.org/FAQs/MacrosVBA/CreateAMacro.htm


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[pwyf]

Thank you, Doug!