Split Words in the comment text - VBA Macro

Hello All,
I am trying to write a macro which will split the comment. My supervisor wants to prioritize the comments. The comment text reads as below
Low : Comment 1
Medium : Comment 2
High: Comment 3
The out put should be displayed in an excel with the following headings
I was able to write a macro to export comments from words to an excel file. However, I am struggling to add this code snippet to split the comment text

Comment ID	Page	Section/Paragraph Name	Comment Scope	Comment text	Priority	Reviewer	Comment Date
1	1	1.1heading1	example heading	Comment 1	Low	BlueDolphin	1/1/1
2	2	1.2heading	example2	Comment 2	Medium	BlueDolphin	1/1/1
3	3	1.3heading	3example3	Comment 3	High	BlueDolphin	1/1/1

Anyhelp is much appreciated
Thanks
BlueDolphin

Since you haven't posted your code or any description of the comment content, we can only guess how you're going about this. Try something along the lines of the following:

Code:

---

Sub ExportComments()
Dim StrCmt As String, StrTmp As String, i As Long, j As Long, xlApp As Object, xlWkBk As Object
StrCmt = "Page,Paragraph,Author,Date & Time,Scope,Prority,Comment"
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 & .Range.ListFormat.ListString & vbTab & .Author & vbTab & .Date & vbTab & .Scope
      StrCmt = StrCmt & vbTab & Trim(Split(.Range.Text, ":")(0)) & vbTab & Trim(Split(.Range.Text, ":")(1))
    End With
  Next
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)
    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:J").AutoFit
  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

---

I've omitted the Comment ID as MS has deprecated support for it.

Here is my code;

Code:

---

Sub exportCommentsToExcel()
Dim xlApp As Object
Dim xlWB As Object
Dim n As Integer, AddRow 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
With xlWB.Worksheets(1)
.Name = "Comments"
    AddRow = 1
    .Cells(AddRow, 1).Formula = "Comment ID"
    .Cells(AddRow, 2).Formula = "Page"
    .Cells(AddRow, 3).Formula = "Paragraph Name"
    .Cells(AddRow, 4).Formula = "Selected text"
    .Cells(AddRow, 5).Formula = "Comment text"
    .Cells(AddRow, 6).Formula = "Reviewer"
    .Cells(AddRow, 7).Formula = "Comment Date"
    strSection = "preamble"
    strTemp = "preamble"
    If ActiveDocument.Comments.Count = 0 Then
        MsgBox ("There are no comments made in this document.")
        Exit Sub
    End If
    For n = 1 To ActiveDocument.Comments.Count
        Set myRange = ActiveDocument.Comments(n).Scope
        strSection = ParentLevel(myRange.Paragraphs(1))
        .Cells(n + AddRow, 1).Formula = ActiveDocument.Comments(n).Index
        .Cells(n + AddRow, 2).Formula = ActiveDocument.Comments(n).Reference.Information(wdActiveEndAdjustedPageNumber)
        .Cells(n + AddRow, 3).Value = strSection
        .Cells(n + AddRow, 4).Formula = ActiveDocument.Comments(n).Scope
        .Cells(n + AddRow, 5).Formula = ActiveDocument.Comments(n).Range
        .Cells(n + AddRow, 6).Formula = ActiveDocument.Comments(n).Author
        .Cells(n + AddRow, 7).Formula = Format(ActiveDocument.Comments(n).Date, "MM/dd/yyyy")
        .Cells(n + AddRow, 8).Formula = ActiveDocument.Comments(n).Range.ListFormat.ListString
    Next n
 
End With
Set xlWB = Nothing
Set xlApp = Nothing
End Sub

---

Code:

---

Function ParentLevel(Para As Word.Paragraph) As String
    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

---

Currently it gives this output

Comment ID	Page	Paragraph Name	Selected Text	Comment text		Reviewer	Comment Date
1	1	1.1heading1	example heading	Comment 1		BlueDolphin	1/1/1
2	2	1.2heading	example2	Comment 2		BlueDolphin	1/1/1
3	3	1.3heading	3example3	Comment 3		BlueDolphin	1/1/1

Did you try the code I posted? Did you look at how I implemented the comment splitting? Your latest table doesn't even indicate the provision for or presence of your priorities.

PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.

I have tried your code, It gives me an error "Runtime error - Subscription out of range. I apologize I didnt know that I had to use code tags.

Quote:

---

Originally Posted by bluedolphin

I have tried your code, It gives me an error "Runtime error - Subscription out of range.

---

That suggests one or more comments don't have the
Low: comment text
Medium: comment text
High: comment text
in them that your first post indicated.

Quote:

---

Originally Posted by bluedolphin

I apologize I didnt know that I had to use code tags.

---

I added them to your post for you

As (the other) Paul says, it makes your macro(s) easier to see and does some formatting

You might take a look at the forum's FAQs (checkout my sig)

Thanks Paul. I did add them comments in that style. The comments I wrote in the document are something like Low:"comment text", etc.. I am trying to do more research on your code to fix the issue. Any help from you is much appreciated.

Thanks so much!! :)

The code I posted works correctly for the comment data you described. If you're not getting the same outcome, either you've modified the code or one or more of your comments don't conform to your description.

I haven't changed your code and my comments this time actually say "comment", The error says " Run-time error '9': Subscript out of range"

In which case one or more of your comments don't conform to your description.

Cross-posted at: https://answers.microsoft.com/en-us/...1-bc479404c314
Kindly read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq...._new_faq_item3

I apologize for posting multiple places. i did not know about cross posting. I am a newbie to VB Macro and infact this is the first time i have posted in a forum. I will take down other posts. Thanks for letting me know

First of all thanks a lot for your help.
I am not sure why the code isn't working at work computer. When I tried at home computer it worked. Apparently, the code is not supportive to 2013 word. I am looking into the code however, any help from you is very much appreciated.

The Word version should be of no consequence. What error message, if any, are you getting?

The error says " Run-time error '9': Subscript out of range". The excel workbook doesn't have any details in it when created. I debugged the code to see where it is failing. Its failing here

Code:

---

For i = 1 To .Comments.Count
            With .Comments(i)
                StrCmt = StrCmt & vbCr & .Reference.Information(wdActiveEndAdjustedPageNumber) & vbTab & .Range.ListFormat.ListString & vbTab & .Author & vbTab & .Date & vbTab & .Scope
                StrCmt = StrCmt & vbTab & Trim(Split(.Range.Text, ":")(0)) & vbTab & Trim(Split(.Range.Text, ":")(1))
            End With
        Next

---

As I have said repeatedly, that error means:

Quote:

---

one or more of your comments don't conform to your description

---

All you're doing is wasting my time (and yours) if you don't fix your comments to make them conform to your own specifications. And I'm not about to waste any more time on that.

I have done exactly like you said. The code doesn't work at work computer.
Thanks for your valuable time.I apologize that i have upset you., I appreciate your help. I will continue to work on it.

Thanks
Jo. D

Maybe you can post a sanitized version of your document here

The document's text most likely isn't important, but include the macro you're using and the comment(s) that show the error

So I used this code. I was not able to trim the comment.

Code:

---

If Left(ActiveDocument.Comments(i).Range, 4) = "HIGH"
Then
.Cells(i + AddRow, 6).Formula = "High"

Else
If Left(ActiveDocument.Comments(i).Range, 6) = "MEDIUM"
Then
.Cells(i + AddRow, 6).Formula = "Medium"

Else
If Left(ActiveDocument.Comments(i).Range, 3) = "LOW"
Then
.Cells(i + AddRow, 6).Formula = "Low"

End If
End If
End If

---

Thanks a lot for your support and guidance.