JLEnglish
07-06-2015, 02:26 AM
Hi,
So, basically I have a lot of word files that I'd like to convert into excel files. I have sets of data in the word files that are labeled. I'd like to put anything under them until the next label in a cell then move on to the next cell. I have working code that completes the task for the first set of data. However, I can't seem to get it to loop and extract from multiple files. Ideally, I'd like for it to finish one set of data, go to the next row, repeat, repeat until the end of the word file. Then, I'd like it to make a new tab and do it for the next word file. I've attached two word files and what I'd like it to look like in excel as an example. Thanks for the help.
13871
13872
13873
Here's the code I have:
Sub Macro()
Dim word_ap As Object
Set word_ap = CreateObject("Word.Application")
word_ap.Visible = True
Dim oDoc As Object
Set oDoc = word_ap.Documents.Open(ThisWorkbook.Path & "\vba_01.docx")
Dim p, v, a, s(1 To 7) As String
a = Split("MAN,WOMAN,KID", ",")
For Each p In oDoc.Paragraphs
v = v & vbLf & p.Range.Text
Next
If v Like "*M*KK*dd*" Then
v = Split(v, a(0))
s(1) = v(0)
s(2) = a(0)
v = Split(v(1), a(1))
s(3) = v(0)
s(4) = a(1)
v = Split(v(1), a(2))
s(5) = v(0)
s(6) = a(2)
s(7) = v(1)
Range("a1").Resize(, 7) = s
End If
oDoc.Close
Set oDoc = Nothing
word_ap.Quit False
Set word_ap = Nothing
End Sub
So, basically I have a lot of word files that I'd like to convert into excel files. I have sets of data in the word files that are labeled. I'd like to put anything under them until the next label in a cell then move on to the next cell. I have working code that completes the task for the first set of data. However, I can't seem to get it to loop and extract from multiple files. Ideally, I'd like for it to finish one set of data, go to the next row, repeat, repeat until the end of the word file. Then, I'd like it to make a new tab and do it for the next word file. I've attached two word files and what I'd like it to look like in excel as an example. Thanks for the help.
13871
13872
13873
Here's the code I have:
Sub Macro()
Dim word_ap As Object
Set word_ap = CreateObject("Word.Application")
word_ap.Visible = True
Dim oDoc As Object
Set oDoc = word_ap.Documents.Open(ThisWorkbook.Path & "\vba_01.docx")
Dim p, v, a, s(1 To 7) As String
a = Split("MAN,WOMAN,KID", ",")
For Each p In oDoc.Paragraphs
v = v & vbLf & p.Range.Text
Next
If v Like "*M*KK*dd*" Then
v = Split(v, a(0))
s(1) = v(0)
s(2) = a(0)
v = Split(v(1), a(1))
s(3) = v(0)
s(4) = a(1)
v = Split(v(1), a(2))
s(5) = v(0)
s(6) = a(2)
s(7) = v(1)
Range("a1").Resize(, 7) = s
End If
oDoc.Close
Set oDoc = Nothing
word_ap.Quit False
Set word_ap = Nothing
End Sub