Export parts of a word document to excel in a prescribed format.

[Rbrown]

I am in the oil and gas business in Calgary. My
particular business requires collecting personal data on a Word form. I then
submit that word document to my parent company. However, before I submit this
word document I take "some" of the data (eg. name,phone number and
addresses) from it and put it on a excel spread sheet that I submit to the
Alberta Government. The Government portion takes alot of my time in a very
rushed atmosphere. Is there some way that I can take pieces from my word
document and "easily" export it to a excel spreadsheet ? If you suggest a VBA
program can you direct me to
someone who can help me with that? If it can't be done at all is there a
program that you can recommend that will do this outside of Microsoft.

I have to say with Word and Excel working so close together all the time I
can imagine this question gets asked quite often.

Look forward to your repl.

Rick

Look forward to your reply.

Look forward to your replyl

 

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

See the following pages from fellow MVP Greg Maxey's website:

http://gregmaxey.mvps.org/Extract_Document_Data.htm

http://gregmaxey.mvps.org/Extract_Form_Data.htm

If you really need to do this using Excel, 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

 

[Rbrown]

Thanks very much Doug.

Although your reply is beyond my understanding of VB, I think what your
saying is that it can be done and that is what I needed to know.

Is there way I can drill down a little farther and show you the documents I
am considering using and how I woud want them exported? Then maybe I could
try programming this myself or have someone do it.

Thanks in advance.

Rick


--
Sincerely,

Rick

See the following pages from fellow MVP Greg Maxey's website:

http://gregmaxey.mvps.org/Extract_Document_Data.htm

http://gregmaxey.mvps.org/Extract_Form_Data.htm

If you really need to do this using Excel, 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

 

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

If you contact my at (e-mail address removed) we can discuss what would be involved in
developing this for you.

--
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

Thanks very much Doug.

Although your reply is beyond my understanding of VB, I think what your
saying is that it can be done and that is what I needed to know.

Is there way I can drill down a little farther and show you the documents
I
am considering using and how I woud want them exported? Then maybe I could
try programming this myself or have someone do it.

Thanks in advance.

Rick

 

[Rbrown]

Great I will get started on a email for you.

Thanks