export word review comments in excel

Mr. Paul,

Thanks a bunch for your response. I sincerely appreciate you taking the time to do so.

I loaded this macro and am getting a Compile Error: Method or data member not found at:

End If

         With .Duplicate

           .End = .End - 1

           StrCmt = StrCmt & Replace(Replace(.Text, vbTab, "<TAB>"), vbCr, "<P>") & vbTab

         End With

       End With

       With .Duplicate      <--------

         .End = .End - 1

         StrCmt = StrCmt & Replace(Replace(.Text, vbTab, "<TAB>"), vbCr, "<P>")

       End With

     End With

Thoughts?

BD

Try:

Sub ExportComments()

Dim StrCmt As String, StrTmp As String, i As Long, j As Long, xlApp As Object, xlWkBk As Object

StrCmt = "Page,Author,Date & Time,H.Lvl,Commented Text,Comment,Reviewer,Resolution,Date Resolved,Edit Doc,Edit By,Edit Date"

StrCmt = Replace(StrCmt, ",", vbTab)

With ActiveDocument

  ' Process the Comments

  For i = 1 To .Comments.Count

    With .Comments(i)

      StrCmt = StrCmt & vbCr & .Reference.Information(wdActiveEndAdjustedPageNumber) & _

        vbTab & .Author & vbTab & .Date & vbTab

      With .Scope

        If InStr(.Paragraphs(1).Style, "Heading") = 1 Then

          StrCmt = StrCmt & .Paragraphs(1).Range.ListFormat.ListString & vbTab

        Else

          StrCmt = StrCmt & ParentLevel(.Paragraphs(1)) & vbTab

        End If

        With .Duplicate

          .End = .End - 1

          StrCmt = StrCmt & Replace(Replace(.Text, vbTab, "<TAB>"), vbCr, "<P>") & vbTab

        End With

      End With

      With .Range.Duplicate

        .End = .End - 1

        StrCmt = StrCmt & Replace(Replace(.Text, vbTab, "<TAB>"), vbCr, "<P>")

      End With

    End With

  Next

  StrTmp = .Name

End With

' Test whether Excel is already running.

On Error Resume Next

Set xlApp = GetObject(, "Excel.Application")

'Start Excel if it isn't running

If xlApp Is Nothing Then

  Set xlApp = CreateObject("Excel.Application")

  If xlApp Is Nothing Then

    MsgBox "Can't start Excel.", vbExclamation

    Exit Sub

  End If

End If

On Error GoTo 0

With xlApp

  Set xlWkBk = .Workbooks.Add

  ' Update the workbook.

  With xlWkBk.Worksheets(1)

    .Name = StrTmp

    .Columns("D").NumberFormat = "@"

    For i = 0 To UBound(Split(StrCmt, vbCr))

      StrTmp = Split(StrCmt, vbCr)(i)

        For j = 0 To UBound(Split(StrTmp, vbTab))

          .Cells(i + 1, j + 1).Value = Split(StrTmp, vbTab)(j)

        Next

    Next

    .Columns("A:L").AutoFit

    .Columns("E:F").ColumnWidth = 25

  End With

  ' Tell the user we're done.

  MsgBox "Workbook updates finished.", vbOKOnly

  ' Switch to the Excel workbook

  .Visible = True

End With

' Release object memory

Set xlWkBk = Nothing: Set xlApp = Nothing

End Sub

Function ParentLevel(Para As Paragraph) As String

Dim ParaHd As Paragraph, StrTmp As String

Set ParaHd = Para

Do While ParaHd.OutlineLevel = Para.OutlineLevel

  Set ParaHd = ParaHd.Previous

Loop

ParentLevel = ParaHd.Range.ListFormat.ListString

End Function

Rather than taking up extra columns for every possible heading level (there could be as many as 9 in a Word document), those data are all output to a single column. The levels should remain quite apparent, there.

First off - I can't thank this community enough for their willingness to assist us less than expert users - which I am far from. And still learning!

Having said that - this macro worked brilliantly at first - and I've researched and tried to add what I needed in addition, and continue to muck things up -

I have a document now that contains Headings 1-5 - for Example:

My Super Fancy Main Heading 1

     Fancy Heading 2

           Fancy Heading 3

                    Fancy Heading 4

                            Fancy Heading 5

Comments can be made at any level - So when I export comments to Excel, per row, I need to capture by column:

Document Name

Comment #

Page #

Each Fancy heading in a separate column

Comment

Commenter

Date Commented

Reviewer (this column is created but will be blank when the spreadsheet is generated)

Resolution (this column is created but will be blank when the spreadsheet is generated)

Date Resolved (this column is created but will be blank when the spreadsheet is generated)

Edit Doc (this column is created but will be blank when the spreadsheet is generated)

Edit By (this column is created but will be blank when the spreadsheet is generated)

Edit Date (this column is created but will be blank when the spreadsheet is generated)

Lastly, and I know beggars can't be choosers - but my documents are anywhere from 600-1500 pages or more (I know, I love my job too)... when I run the original macro against it (which is great btw) - it can take HOURS. Is that just the size of the document et all, or is there something greater going on?

I sincerely appreciate any assistance I can get on this - you all RAWK!

Brandi

Sub exportComments()

' Exports comments from a MS Word document to Excel and associates them with the heading paragraphs

' they are included in. Useful for outline numbered section, i.e. 3.2.1.5....

' Thanks to Graham Mayor, http://answers.microsoft.com/en-us/office/forum/office\_2007-customize/export-word-review-comments-in-excel/54818c46-b7d2-416c-a4e3-3131ab68809c

' and Wade Tai, http://msdn.microsoft.com/en-us/library/aa140225(v=office.10).aspx

' Need to set a VBA reference to "Microsoft Excel 14.0 Object Library"

Dim xlApp As Excel.Application

Dim xlWB As Excel.Workbook

Dim i As Integer, HeadingRow As Integer

Dim objPara As Paragraph

Dim objComment As Comment

Dim strSection As String

Dim strTemp

Dim myRange As Range

Set xlApp = CreateObject("Excel.Application")

xlApp.Visible = True

Set xlWB = xlApp.Workbooks.Add 'create a new workbook

With xlWB.Worksheets(1)

' Create Heading

    HeadingRow = 1

    .Cells(HeadingRow, 1).Formula = "Comment"

    .Cells(HeadingRow, 2).Formula = "Page"

    .Cells(HeadingRow, 3).Formula = "Paragraph"

    .Cells(HeadingRow, 4).Formula = "Comment"

    .Cells(HeadingRow, 5).Formula = "Reviewer"

    .Cells(HeadingRow, 6).Formula = "Date"

    strSection = "preamble" 'all sections before "1." will be labeled as "preamble"

    strTemp = "preamble"

    If ActiveDocument.Comments.Count = 0 Then

        MsgBox ("No comments")

        Exit Sub

    End If

    For i = 1 To ActiveDocument.Comments.Count

        Set myRange = ActiveDocument.Comments(i).Scope

        strSection = ParentLevel(myRange.Paragraphs(1)) ' find the section heading for this comment

        'MsgBox strSection

        .Cells(i + HeadingRow, 1).Formula = ActiveDocument.Comments(i).Index

        .Cells(i + HeadingRow, 2).Formula = ActiveDocument.Comments(i).Reference.Information(wdActiveEndAdjustedPageNumber)

        .Cells(i + HeadingRow, 3).Value = strSection

        .Cells(i + HeadingRow, 4).Formula = ActiveDocument.Comments(i).Range

        .Cells(i + HeadingRow, 5).Formula = ActiveDocument.Comments(i).Initial

        .Cells(i + HeadingRow, 6).Formula = Format(ActiveDocument.Comments(i).Date, "dd/MM/yyyy")

        .Cells(i + HeadingRow, 7).Formula = ActiveDocument.Comments(i).Range.ListFormat.ListString

    Next i

End With

Set xlWB = Nothing

Set xlApp = Nothing

End Sub

Function ParentLevel(Para As Word.Paragraph) As String

'From Tony Jollans

' Finds the first outlined numbered paragraph above the given paragraph object

    Dim ParaAbove As Word.Paragraph

    Set ParaAbove = Para

    sStyle = Para.Range.ParagraphStyle

    sStyle = Left(sStyle, 4)

    If sStyle = "Head" Then

        GoTo Skip

    End If

    Do While ParaAbove.OutlineLevel = Para.OutlineLevel

        Set ParaAbove = ParaAbove.Previous

    Loop

Skip:

    strTitle = ParaAbove.Range.Text

    strTitle = Left(strTitle, Len(strTitle) - 1)

    ParentLevel = ParaAbove.Range.ListFormat.ListString & " " & strTitle

End Function

Thanks for the great code

Please add the following definitions to the Function ParentLevel():

    Dim sStyle As Variant

    Dim strTitle As String

Adding those makes the code work perfectly.

Thanks

Luke

I have Word 2013 and am getting the same error, I do not have section numbers in my document, and do not know how to add the late binding as you described.  

Run-time error '91'

Object variable or With block variable not set

This is the offending line:

sStyle = Para.Range.ParagraphStyle

How can I fix this?

Thanks