Split Words in the comment text - VBA Macro

[bluedolphin]

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

[macropod]

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:

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.

[bluedolphin]

Here is my 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(wdActiveEndAdjustedPageNum ber)
.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






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

[macropod]

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.

[bluedolphin]

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.

[macropod]

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.

[Paul_Hossler]

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)

[bluedolphin]

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.

[bluedolphin]

Thanks so much!! :)

[macropod]

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.

[bluedolphin]

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"

[macropod]

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

[macropod]

Cross-posted at: https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-msoffice_custom-msoversion_other/split-words-in-the-comment-text-vba-macro/2a644bd2-8cac-4bd6-b8f1-bc479404c314
Kindly read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3

[bluedolphin]

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

[bluedolphin]

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.

[macropod]

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

[bluedolphin]

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


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

[macropod]

As I have said repeatedly, that error means:

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.

[bluedolphin]

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

[Paul_Hossler]

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

[bluedolphin]

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

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.