Word Comments to Excel - (Yes, again)

[membrain]

Hi to all!

I have been playing with the macro originally provided in the now closed thread #86189-Macro-to-Export-Comments-and-Tracked-Changes-(2003-SP1), which was addressed in 2006.

I have this macro working, but want to add 3 more columns for the Comment Number, Authors Name and Context to the spreadsheet.

So far, I have been able to get the excel spreadsheet to add the needed column headers, but I am unable to populate these 3 new columns as they are conditional, based on if the reviewer has entered a comment versus a formatting change.


Given this, I have lines populating the 3 new cells in the rows (4= Comment#, 5= Author, 6= Context) with the same text as the header. For the moment, this is just a placeholder until I can determine the macro code needed to populate those 3 new cells.


To get past the "value out of range" error, I need help defining CommentNumber, AuthorName and Context as called for in the following macro... I know I'm missing something:

Current Macro follows:

Sub ExportCommentsToExcel()
'
' ExportCommentsToExcel Macro
'
'
Dim revNext As Revision
Dim cmntNext As Comment
Dim blnNotActive As Boolean
Dim xlApp As Excel.Application
Dim wbkOutput As Excel.Workbook
Dim iRow As Integer

' No error messages here
On Error Resume Next

' Check whether Excel is active
Set xlApp = GetObject(, "Excel.application")
blnNotActive = (Err <> 0)
If blnNotActive Then
    ' If not, we start Excel
    Err.Clear
    Set xlApp = CreateObject("Excel.application")
End If

Set wbkOutput = xlApp.Workbooks.Add

' Resume standard error handling here
On Error GoTo 0
     
    ' Heading row
    wbkOutput.Worksheets(1).Cells(1, 1) = "Section"
    wbkOutput.Worksheets(1).Cells(1, 2) = "Page"
    wbkOutput.Worksheets(1).Cells(1, 3) = "Type"
    wbkOutput.Worksheets(1).Cells(1, 4) = "Comment#"
    wbkOutput.Worksheets(1).Cells(1, 5) = "Author"
    wbkOutput.Worksheets(1).Cells(1, 6) = "Context"
    wbkOutput.Worksheets(1).Cells(1, 7) = "Text"
    wbkOutput.Worksheets(1).Cells(1, 8) = "Scope"
    iRow = 1
    
    For Each revNext In ActiveDocument.Revisions
        iRow = iRow + 1
    
        wbkOutput.Worksheets(1).Cells(iRow, 1) = revNext.Range.Information(wdActiveEndSectionNumber)
        wbkOutput.Worksheets(1).Cells(iRow, 2) = revNext.Range.Information(wdActiveEndAdjustedPageNumber)
        wbkOutput.Worksheets(1).Cells(iRow, 7) = revNext.Range.Text
        Select Case revNext.Type
            Case wdNoRevision
                wbkOutput.Worksheets(1).Cells(iRow, 3) = "No Revision"
            Case wdRevisionDelete
                wbkOutput.Worksheets(1).Cells(iRow, 3) = "Delete"
            Case wdRevisionInsert
                wbkOutput.Worksheets(1).Cells(iRow, 3) = "Insert"
            Case wdRevisionParagraphProperty
                wbkOutput.Worksheets(1).Cells(iRow, 3) = "Paragraph Property"
            Case wdRevisionReconcile
                wbkOutput.Worksheets(1).Cells(iRow, 3) = "Reconcile"
            Case wdRevisionSectionProperty
                wbkOutput.Worksheets(1).Cells(iRow, 3) = "Section Property"
            Case wdRevisionStyleDefinition
                wbkOutput.Worksheets(1).Cells(iRow, 3) = "Style Definition"
            Case wdRevisionConflict
                wbkOutput.Worksheets(1).Cells(iRow, 3) = "Revision Conflict"
            Case wdRevisionDisplayField
                wbkOutput.Worksheets(1).Cells(iRow, 3) = "Display Field"
            Case wdRevisionParagraphNumber
                wbkOutput.Worksheets(1).Cells(iRow, 3) = "Paragraph Number"
            Case wdRevisionProperty
                wbkOutput.Worksheets(1).Cells(iRow, 3) = "Property"
            Case wdRevisionReplace
                wbkOutput.Worksheets(1).Cells(iRow, 3) = "Replace"
            Case wdRevisionStyle
                wbkOutput.Worksheets(1).Cells(iRow, 3) = "Style"
            Case wdRevisionTableProperty
                wbkOutput.Worksheets(1).Cells(iRow, 3) = "Table Property"
        End Select
    Next revNext
    For Each cmntNext In ActiveDocument.Comments
        iRow = iRow + 1
    
        wbkOutput.Worksheets(1).Cells(iRow, 1) = cmntNext.Reference.Information(wdActiveEndSectionNumber)
        wbkOutput.Worksheets(1).Cells(iRow, 2) = cmntNext.Reference.Information(wdActiveEndAdjustedPageNumber)
        wbkOutput.Worksheets(1).Cells(iRow, 3) = "Comment"
        wbkOutput.Worksheets(1).Cells(iRow, 4) = cmntNext.Reference.Information(wdActiveEndCommentNumber)
        wbkOutput.Worksheets(1).Cells(iRow, 5) = cmntNext.Reference.Information(wdActiveEndAuthorName)
        wbkOutput.Worksheets(1).Cells(iRow, 6) = cmntNext.Reference.Information(wdActiveEndContext)
        wbkOutput.Worksheets(1).Cells(iRow, 7) = cmntNext.Range.Text
        wbkOutput.Worksheets(1).Cells(iRow, 8) = Left(cmntNext.Scope.Text, 50)
    Next cmntNext

    wbkOutput.Close ' will prompt user to save the output file
    If Not blnNotActive Then xlApp.Quit
    Set wbkOutput = Nothing
    Set xlApp = Nothing

End Sub

TIA,

[jscher2000]

I think the problem is you are improvising constants that don't exist. Instead, explore the properties and values of each Comment object using the Stop command, or your favorite object reference tool.

Sub CommentProps()
Dim cmntNext As Word.Comment
For Each cmntNext In ActiveDocument.Comments
    Stop  ' To inspect this comment object, use View > Locals; F5 to resume
    Debug.Print "Number=[" & cmntNext.Initial & cmntNext.Index & "]"
    Debug.Print "Author=" & cmntNext.Author
    Debug.Print "Comment Text='" & cmntNext.Range.Text & "'"
    Debug.Print "Comment Attached to '" & Left(cmntNext.Scope.Text, 50) & "'" & vbCrLf
Next cmntNext
' to read the output, open the Immediate Window (Ctrl+g)
End Sub

[membrain]

Thanks for the reply.

Yes, trying to add the additional constants without thoroughly researching...

Having seen another macro provide a portion of what I'm looking for, but provides it in a different manner is what is driving my current issue.

[jscher2000]

Hopefully my sample macro pinpoints the properties you need to complete your code.

[membrain]

I'm not at work at the moment, but will certainly add your code to the macro for further testing to see what happens.

[jscher2000]

My sample macro is meant to help you explore and identify the properties you will want to retrieve from your document. It is not meant to plug into your existing macro.