question

SHANTANUBELSARE-4399 avatar image
0 Votes"
SHANTANUBELSARE-4399 asked SHANTANUBELSARE-4399 commented

Extracting Original comments and replies for word document

Dear Team,

I want to create macro which shall fetch the threaded comment list from word document in which Original comment and comment responses to be captured in separate columns. E.g in case if word para is having comment for which there are 4 replies then original comment shall be in first column and next four columns shall capture the 4 replies. Please find below in-progress macro for reference

Sub CopyCommentsToExcel_SB1_WIP()
'Create in Word vba
Dim xlApp As Object
Dim xlWB As Object
Dim i As Integer
Dim HeadingRow As Integer
Dim objPara As Paragraph
Dim objComment As Comment
Dim strSection As String
Dim strTemp
Dim myRange As Range

Dim oComments As Comments
Dim oComment As Comment
Dim lngIndex As Long

Dim iR As Long
Dim IRCol As Long

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Add ' create a new workbook

With xlWB.Worksheets(1)

' Below code Creates and controls Heading in excel file

 HeadingRow = 1
   
 .Cells(HeadingRow, 1).Formula = "SR#"
 .Cells(HeadingRow, 2).Formula = "Page#"
 .Cells(HeadingRow, 3).Formula = "OriginalText"
 .Cells(HeadingRow, 4).Formula = "CommentText"
 .Cells(HeadingRow, 5).Formula = "Name"
 .Cells(HeadingRow, 6).Formula = "Date"
 .Cells(HeadingRow, 7).Formula = "DocumentName"
 .Cells(HeadingRow, 8).Formula = "Comment Type"
 .Cells(HeadingRow, 9).Formula = "Resolved ?"
 .Cells(HeadingRow, 10).Formula = "Replies#"

End With

With xlWB.Worksheets(1)
' For i = 1 To ActiveDocument.Comments.Count 'Original loop
For i = 1 To ActiveDocument.Comments.Count

         .Cells(i + 1, 1).Formula = ActiveDocument.Comments(i).Index
         .Cells(i + 1, 2).Formula = ActiveDocument.Comments(i).Reference.Information(wdActiveEndAdjustedPageNumber)
         .Cells(i + 1, 3).Formula = ActiveDocument.Comments(i).Scope
         .Cells(i + 1, 4).Formula = ActiveDocument.Comments(i).Range.Text
         .Cells(i + 1, 5).Formula = ActiveDocument.Comments(i).Contact
         .Cells(i + 1, 6).Formula = Format(ActiveDocument.Comments(i).Date, "dd-MMM-YY")
         .Cells(i + 1, 7).Formula = ActiveDocument.Comments.Parent
         .Cells(i + 1, 8).Formula = ""

' .Cells(i + 1, 8).Formula = Format(Range("H2").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
' Formula1:="Orange,Apple,Mango,Pear,Peach)

         .Cells(i + 1, 9).Formula = ActiveDocument.Comments(i).Done
         .Cells(i + 1, 10).Formula = ActiveDocument.Comments(i).Replies.Count

' .Cells(i + 1, 9).Formula = ActiveDocument.Comments(i).Ancestor.Index
' .Cells(i + 1, 7).Formula = ActiveDocument.Comments.Count
' .Cells(i + 1, 8).Formula = ActiveDocument.Comments.Application
' .Cells(i + 1, 9).Formula = ActiveDocument.Comments(i).Range.ListFormat.ListString
' .Cells(i + 1, 4).Formula = ActiveDocument.Comments(i).Initial


' Set oComments = ActiveDocument.Comments
' For Each oComment In oComments
' If oComment.Replies.Count > 0 Then
' For lngIndex = 1 To oComment.Replies.Count
' MsgBox oComment.Replies(lngIndex).Range.Text
' Next
' End If

   Set oComments = ActiveDocument.Comments
     For Each oComment In oComments
         If oComment.Replies.Count > 0 Then
             For lngIndex = 1 To oComment.Replies.Count
 '               MsgBox oComment.Replies(lngIndex).Range.Text
                 iR = 1
                 IRCol = 11
                     For iR = 1 To oComment.Replies.Count
                         .Cells(1, IRCol).Formula = "Reply " & iR
                 '        .Cells(i, IRCol).Formula = oComment.Replies(lngIndex).Range.Text
                 '        = oComment.Replies(iR).Creator _
                 '        & vbCrLf _
                 '        & oComment.Replies(iR).Date _
                 '        & vbCrLf _
                 '        & oComment.Replies(lngIndex).Range.Text
                     IRCol = IRCol + 1
                     Next iR
        
             Next
         End If
     Next

'lbl_Exit:
'Exit Sub

 Next i

End With

'Creating the the table from the the captured content from current sheet

'With xlWB.Worksheets(1)
'.ListObjects.Add(xlSrcRange,
'.Cells(1, 1)

'.CurrentRegion, , xlYes)
'.Name = ""
'End With
''Changing the Table Style only
'Set mylist = newwks.ListObjects(1)
'mylist.TableStyle = "TableStyleLight7"
'listcols = mylist.DataBodyRange

'.Columns.Count
''Below code block is for formatting the captured content only
'With mylist.DataBodyRange
'.Cells.VerticalAlignment = xlTop
'.Columns.EntireColumn.ColumnWidth = 30
'.Cells.WrapText = True
'.Columns.EntireColumn.AutoFit
'.Rows.EntireRow.AutoFit
'End With

'With xlWB.Worksheets(1)
' Range("Q2").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
' Formula1:="Orange,Apple,Mango,Pear,Peach"
'End With


Application.ScreenUpdating = True
Set xlWB = Nothing
Set xlApp = Nothing
End Sub

office-vba-dev
5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

1 Answer

35366280 avatar image
0 Votes"
35366280 answered SHANTANUBELSARE-4399 commented

i don`t understand your problem

· 1
5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

Hello All,

Problem Statement: Need a macro which can generate a list of Word file comments in new excel file with comments and replies to comment in seperate columns.

E.g please find below columns for word comment attributes column wise

SR.
First comment
Reply 1
Reply 2

Reply n

Please let me know any additional information is required.

The macro which I have pasted above generates a list of comments altogether original comments and replies in altogether. I am not able to index the replies of parent comments in different columns.

0 Votes 0 ·