CODEWITHSUNDEEP
vba
philcolbourn
philcolbourn

Reputation: 4122

in VBA (word) how do I add a comment to a range only if no comments exist?

Using a range.Find object in a Word document I loop through all matches and add a comment.

But if a comment already exists I do not want to add another comment - so I can run VBA script numerous times on same document.

Here is my loop:

Dim all As Range
Set all = pcSetupFind(word, wdFindStop)  ' setup all.find to find 'word'
While all.Find.Execute
  If all.Find.Found Then
    If all.Comments.Count = 0 Then Call all.Comments.Add(all, comment)
  End If
Wend

But, it always adds a comment.

How do I add a comment on a range only when no comment exists?

Upvotes: 2

Views: 2356

Answers (2)

philcolbourn
philcolbourn

Reputation: 4122

I took PeterT's method and implemented it differently.

Function pcHasComments(rng As Range) As Boolean

  Dim com As comment

  For Each com In ActiveDocument.comments
    If com.scope.Start = rng.Start And com.scope.End = rng.End Then
      'MsgBox ("found comment")
      pcHasComments = True
      Exit Function
    End If
  Next

  pcHasComments = False

End Function

Upvotes: 0

PeterT
PeterT

Reputation: 8557

When you want to check if a comment is already attached to a given part of the document (a word, a sentence -- a Range), then you have to compare that range to the ranges of any/all existing comments.

Option Explicit

Function CommentExistsInRange(checkRange As Range) As Boolean
    '--- compares all existing comments to the given range and
    '    checks for a match.
    '    RETURNS true if a comment exists for the given range
    Dim commentScope As Range
    Dim i As Integer
    Dim totalComments As Integer
    totalComments = ActiveDocument.Comments.Count
    CommentExistsInRange = False
    If totalComments > 0 Then
        For i = 1 To totalComments
            Set commentScope = ActiveDocument.Comments.Item(i).Scope
            If (checkRange.Start = commentScope.Start) And _
               (checkRange.End = commentScope.End) Then
                CommentExistsInRange = True
                Exit Function
            End If
        Next i
    End If
End Function

Sub FindAndComment(findText As String, searchRange As Range, newComment As String)
    Dim foundTextRange As Range
    With searchRange
        .Find.Text = findText
        .Find.Wrap = wdFindStop
        .Find.Forward = True
        While .Find.Execute
            If .Find.Found Then
                .Select
                Set foundTextRange = ActiveDocument.Range(Selection.Range.Start, _
                                                          Selection.Range.End)
                If Not CommentExistsInRange(foundTextRange) Then
                    Call ActiveDocument.Comments.Add(foundTextRange, newComment)
                End If
            End If
        Wend
    End With
End Sub

Sub Test()
    FindAndComment "Office", ActiveDocument.Range, "Around the Office watercooler"
End Sub

Upvotes: 4

Related Questions