vba word add comment and author - vba

Question

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

Answer 1

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