Home » excel » I would like to extract paragraphs from word and import it to cells in a excel spreadsheet keeping bullet numbers and letters

I would like to extract paragraphs from word and import it to cells in a excel spreadsheet keeping bullet numbers and letters

Posted by: admin May 14, 2020 Leave a comment

Questions:

I need to take a word document and export its paragraphs (hard breaks) into single cells in a excel spreadsheet keeping bullet numbers and letters along with the text, tables and diagrams.

I assume VBA would be the best approach.

I am using office 2007.

How to&Answers:

Something like this?

Sub ReadContenttoExcel()
Dim DocPara As Paragraph

' work with the new excel workbook
    Dim oXL As Excel.Application
    Dim oWB As Excel.Workbook
    Dim oSheet As Excel.Worksheet
    Dim oRng As Excel.Range
    Dim ExcelWasNotRunning As Boolean
    Dim WorkbookToWorkOn As String
    Dim xxRow, xxCol As Integer
    'specify the workbook to work on
    WorkbookToWorkOn = "D:\test.xlsx"
    xxRow = 1
    xxCol = 1

    '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


    'Open the workbook
    Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)
    Set oSheet = oWB.Sheets(1)
    oSheet.Activate


    ' Parameters for testing -- see whats happening
    With oXL
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
        .Visible = True
    End With


    'Run through the Document and Save each of the Heading 1 Texts to Excel

        For Each DocPara In ActiveDocument.Paragraphs

            Select Case (DocPara.Range.Style)
                Case "Heading 1"
                    'Debug.Print "Heading1~" & Left(DocPara.Range.Text, Len(DocPara.Range.Text) - 1)
                    xxRow = xxRow + 1
                    oSheet.Cells(xxRow, 1).Value = Left(DocPara.Range.Text, Len(DocPara.Range.Text) - 1)
                Case "Heading 2"
                    oSheet.Cells(xxRow, 2).Value = Left(DocPara.Range.Text, Len(DocPara.Range.Text) - 1)
                Case "Heading 3"
                    oSheet.Cells(xxRow, 3).Value = Left(DocPara.Range.Text, Len(DocPara.Range.Text) - 1)
                Case "Heading 4"
                    oSheet.Cells(xxRow, 4).Value = Left(DocPara.Range.Text, Len(DocPara.Range.Text) - 1)
                Case Else
                    oSheet.Cells(xxRow, 5).Value = Left(DocPara.Range.Text, Len(DocPara.Range.Text) - 1)
           End Select
           xxRow = xxRow + 1
        Next

      ActiveWorkbook.Save
      If ExcelWasNotRunning Then
        oXL.Quit
      End If

    'Realease the Object References
    Set oRng = Nothing
    Set oSheet = Nothing
    Set oWB = Nothing
    Set oXL = Nothing 
End Sub

Answer:

Save as .htm then open with excell.