Hi,
I have ~350 Word documents and I need to extract the contents of each of them to excel (I can sort it out once it gets to excel). I have managed to extract the tables (see below) but I now need to extract the paragraphs as well. I'm hoping this is very easy modification, but I am struggling a bit as I'm new to VB. Any help would be appreciated. This is what I have so far and it works fine.. as far as tables are concerned
xl.Workbooks.Add
xl.Visible = True
'Here put your path where you have your documents to read:
myPath = "C:\temp\george4" 'End with '\'
myFile = Dir(myPath & "*.doc")
z = 1
xlRow = 1
Do While myFile <> ""
Documents.Open myPath & myFile
If ActiveDocument.Tables.Count < 3 Then
MsgBox ("Non standard layout @ " & z)
Else
For Each t In ActiveDocument.Tables
For Each r In t.Rows
xlCol = 1
For Each c In r.Range.Cells
myText = c.Range.Text
myText = Replace(myText, Chr(13), "")
myText = Replace(myText, Chr(7), "")
xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, xlCol) = myText
xlCol = xlCol + 1
Next c
xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, xlCol + 1) = myFile
xlRow = xlRow + 1
Next r
xlRow = xlRow + 1
Next t
End If
ActiveWindow.Close False
myFile = Dir
z = z + 1
Loop
End Sub
I have ~350 Word documents and I need to extract the contents of each of them to excel (I can sort it out once it gets to excel). I have managed to extract the tables (see below) but I now need to extract the paragraphs as well. I'm hoping this is very easy modification, but I am struggling a bit as I'm new to VB. Any help would be appreciated. This is what I have so far and it works fine.. as far as tables are concerned
xl.Workbooks.Add
xl.Visible = True
'Here put your path where you have your documents to read:
myPath = "C:\temp\george4" 'End with '\'
myFile = Dir(myPath & "*.doc")
z = 1
xlRow = 1
Do While myFile <> ""
Documents.Open myPath & myFile
If ActiveDocument.Tables.Count < 3 Then
MsgBox ("Non standard layout @ " & z)
Else
For Each t In ActiveDocument.Tables
For Each r In t.Rows
xlCol = 1
For Each c In r.Range.Cells
myText = c.Range.Text
myText = Replace(myText, Chr(13), "")
myText = Replace(myText, Chr(7), "")
xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, xlCol) = myText
xlCol = xlCol + 1
Next c
xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, xlCol + 1) = myFile
xlRow = xlRow + 1
Next r
xlRow = xlRow + 1
Next t
End If
ActiveWindow.Close False
myFile = Dir
z = z + 1
Loop
End Sub