Sub ReadEachDocParagraphs() Dim pWord As Object, pSheet As Worksheet, pDoc As Object Dim i As Long, text As String, pParagraph As Object 'Set pSheet = ThisWorkbook.Worksheets.Add Set pWord = CreateObject("Word.Application") Set pDoc = pWord.Documents.Open(ThisWorkbook.Path & "\11.doc", True) For Each pParagraph In pDoc.Paragraphs text = Trim$(Replace$(pParagraph.Range.text, vbCr, "")) If text <> "" Then i = i + 1 'pSheet.Cells(i, 1).Value = text Cells(i + 2, 3).Value = text End If Next pDoc.Close pWord.Quit End Sub
[/vba]
[vba]
Код
Sub ReadEachDocParagraphs() Dim pWord As Object, pSheet As Worksheet, pDoc As Object Dim i As Long, text As String, pParagraph As Object 'Set pSheet = ThisWorkbook.Worksheets.Add Set pWord = CreateObject("Word.Application") Set pDoc = pWord.Documents.Open(ThisWorkbook.Path & "\11.doc", True) For Each pParagraph In pDoc.Paragraphs text = Trim$(Replace$(pParagraph.Range.text, vbCr, "")) If text <> "" Then i = i + 1 'pSheet.Cells(i, 1).Value = text Cells(i + 2, 3).Value = text End If Next pDoc.Close pWord.Quit End Sub