export word review comments

comments2Table.vbs

'By:
'Doug Robbins - Word MVP
'dkr@mvps.org
'dougrobbinsmvp@gmail.com
'http://answers.microsoft.com/en-us/office/forum/office_2007-customize/export-word-review-comments-in-excel/54818c46-b7d2-416c-a4e3-3131ab68809c?page=4&rtAction=1429151921582
'
'Creates a new document containing a table that displays the Page Number, the number of the Section in the document, the line number, the text upon which the comment is made, the text of the comment and the name of the person who made the comment.
'If the text upon which the comment was made, the table will include the contents of the cell that contain that text.  If the text is not in a table, it will display the text of the first paragraph to which the comment applies

 Dim source As Document, target As Document
 Dim tblTarget As Table
 Dim rowTarget As Row
 Dim i As Long, j As Long, p As Long, s As Long
 Dim strComment As String
 Dim strinitials As String
 Dim rngText As Range
 Set source = ActiveDocument
 Set target = Documents.Add
 Set tblTarget = target.Tables.Add(target.Range, 1, 6)
 With tblTarget
     .Cell(1, 1).Range.Text = "Page"
     .Cell(1, 2).Range.Text = "Section"
     .Cell(1, 3).Range.Text = "Line"
     .Cell(1, 4).Range.Text = "Text"
     .Cell(1, 5).Range.Text = "Comment"
     .Cell(1, 6).Range.Text = "Name"
 End With
 With source
     For i = 1 To .Comments.Count
         p = .Comments(i).Reference.Information(wdActiveEndPageNumber)
         s = .Comments(i).Reference.Information(wdActiveEndSectionNumber)
         l = .Comments(i).Reference.Information(wdFirstCharacterLineNumber)
         Set rngText = .Comments(i).Reference
        If rngText.Information(wdWithInTable) = True Then
            Set rngText = .Comments(i).Reference.Cells(1).Range
            rngText.End = rngText.End - 1
        Else
            Set rngText = .Comments(i).Reference.Paragraphs(1).Range
            rngText.End = rngText.End - 1
        End If
         strComment = .Comments(i).Range.Text
         strinitials = .Comments(i).Author
         Set rowTarget = tblTarget.Rows.Add
         With rowTarget
             .Cells(1).Range.Text = p
             .Cells(2).Range.Text = s
             .Cells(3).Range.Text = l
             .Cells(4).Range.Text = rngText.Text
             .Cells(5).Range.Text = strComment
             .Cells(6).Range.Text = strinitials
         End With
     Next i
 End With