CODEWITHSUNDEEP
excelvbams-wordcommentsparagraph
Richard Crabtree
Richard Crabtree

Reputation: 1

I want copy the paragraph that a comment has been added to in Word and put into an Excel table

I found a really simple macro in LinkedIn, from 'Harriet. L', to look at the Comments in a Word document and create an Excel table showing the 'page, author, comment text & date created' for each comment in the document (see VBA code below).

That works brilliantly - but I'd also like to grab all the text of the paragraph that the comment is within so that there is some context to the comment, when seen in the Excel table.

Any ideas??

Harriet's VBA Code...

Sub ExportCommentsToExcel()
    Dim xlApp As Object, xlWB As Object
    Dim i As Integer
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add
    With xlWB.Worksheets(1)
        ' Set header values
        .Cells(1, 1).Value = "Page Number"
        .Cells(1, 2).Value = "Author's Name"
        .Cells(1, 3).Value = "Comment"
        .Cells(1, 4).Value = "Date"
    
        ' Format headers
        With .Range("A1:D1")
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .Interior.Color = RGB(191, 191, 191) ' Grey color
            .Borders.Weight = xlThin
            .Borders.LineStyle = xlContinuous
        End With
    
        ' Populate the data
        For i = 1 To ActiveDocument.Comments.Count
            .Cells(i + 1, 1).Value = ActiveDocument.Comments(i).Scope.Information(wdActiveEndPageNumber)
            .Cells(i + 1, 2).Value = ActiveDocument.Comments(i).Author
            .Cells(i + 1, 3).Value = ActiveDocument.Comments(i).Range.Text
            .Cells(i + 1, 4).Value = Format(ActiveDocument.Comments(i).Date, "dd/mm/yyyy")
        Next i
    
        ' AutoFit columns for responsiveness
        .Columns("A:D").AutoFit
    End With
    Set xlWB = Nothing
    Set xlApp = Nothing
End Sub

Upvotes: 0

Views: 87

Answers (1)

Rob Bennett
Rob Bennett

Reputation: 51

In your section 'Set header values, add this line:

.Cells(1, 5).Value = "Source Text"

And in your section 'Populate the data, add this line:

.Cells(i + 1, 5).Value = ActiveDocument.Comments(i).Scope.Text

Fully modified code here:

Sub ExportCommentsToExcel()
    Dim xlApp As Object, xlWB As Object
    Dim i As Integer
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add
    With xlWB.Worksheets(1)
        ' Set header values
        .Cells(1, 1).Value = "Page Number"
        .Cells(1, 2).Value = "Author's Name"
        .Cells(1, 3).Value = "Comment"
        .Cells(1, 4).Value = "Date"
        .Cells(1, 5).Value = "Source Text"

        ' Format headers
        With .Range("A1:E1")
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .Interior.Color = RGB(191, 191, 191) ' Grey color
            .Borders.Weight = xlThin
            .Borders.LineStyle = xlContinuous
        End With

        ' Populate the data
        For i = 1 To ActiveDocument.Comments.Count
            .Cells(i + 1, 1).Value = ActiveDocument.Comments(i).Scope.Information(wdActiveEndPageNumber)
            .Cells(i + 1, 2).Value = ActiveDocument.Comments(i).Author
            .Cells(i + 1, 3).Value = ActiveDocument.Comments(i).Range.Text
            .Cells(i + 1, 4).Value = Format(ActiveDocument.Comments(i).Date, "dd/mm/yyyy")
            .Cells(i + 1, 5).Value = ActiveDocument.Comments(i).Scope.Text
        Next i

        ' AutoFit columns for responsiveness
        .Columns("A:E").AutoFit
    End With
    Set xlWB = Nothing
    Set xlApp = Nothing
End Sub

Hope that helps!

Upvotes: 0

Related Questions