CODEWITHSUNDEEP
vbams-wordcommentsauthor
user366121
user366121

Reputation: 3271

vba word add comment and author

I have a user form in Word 2007 which searches for specific terms in a document and adds comments. I have three different categories for these comments. I want the comments to be color coded for each category. For the moment I have a solution which works but it is very slow. Is there another way to assign a comment author directly when creating the comments?

Code for comment creation:

For i = 0 To UBound(CritArray)
    PosCount = 1
    With Selection
    .HomeKey wdStory
        With .Find
        .ClearFormatting
            Do While .Execute(FindText:=CritArray(i), _
            Forward:=True, _
            MatchWholeWord:=True)
Select Case i
...
End Select
            PosCount = PosCount + 1

            Selection.Comments.Add _
            Range:=Selection.Range, _
            Text:=MessArray(i) & CritArray(i) & "' - found for the" & Str(FoundCount) & ". time"

            Loop

        End With
    End With
Next

Code for assigning a different author to each comment - this results in different color coded comments if under Review>Track Changes>Track Changes Options>Comments by author is selected:

Dim CurrentExpField As String

For Each objCom In ActiveDocument.Comments

    CurrentExpField = Left$(objCom.Range.Text, 3)
    objCom.Author = UCase(CurrentExpField)
    objCom.Initial = UCase(CurrentExpField)

Next

Upvotes: 2

Views: 7084

Answers (1)

i_saw_drones
i_saw_drones

Reputation: 3506

Yes, it is possible to set additional properties for a Comment after it is created since the Add method for Comments returns a reference to a new Comment object. This means that you can do your colour-coding in one pass. I modified your code slightly to do this as follows:

Dim cmtMyComment as Comment

For i = 0 To UBound(CritArray)
    PosCount = 1
    With Selection
    .HomeKey wdStory
        With .Find
        .ClearFormatting
            Do While .Execute(FindText:=CritArray(i), _
            Forward:=True, _
            MatchWholeWord:=True)
Select Case i
...
End Select
            PosCount = PosCount + 1

            Set cmtMyComment = Selection.Comments.Add(Range:=Selection.Range, _
            Text:=MessArray(i) & CritArray(i) & "' - found for the" & Str(FoundCount) & ". time")

            cmtMyComment.Author = UCase(Left$(cmtMyComment.Range.Text, 3))
            cmtMyComment.Initial = UCase(Left$(cmtMyComment.Range.Text, 3))

            Loop

        End With
    End With
Next

Upvotes: 4

Related Questions