Find, Replace and Comment [Word VBScript]

Hi there. I wrote a Find and Replace script for Word, which also adds a Comment for each replacement. Note: It works only on the 'body' of the text, since comments are not available on footnotes / endnotes.

Sub find_comment() ' Find, Replace and Comment ' (c) Oren Hadar, 2009 Dim myFind Dim myReplace Dim okInput Dim myCount Dim myContinue Dim myRetry myCount = 0 okInput = False Do myFind = InputBox("Find what:", "Find and Comment") If StrPtr(myFind) = False Then Exit Sub ElseIf myFind = "" Then myRetry = MsgBox("No find string was entered.", _ vbRetryCancel + vbExclamation, "Find and Comment") Else okInput = True End If If myRetry = vbCancel Then Exit Sub End If Loop While okInput = False okInput = False Do myReplace = InputBox("Replace with:", "Find and Comment") If StrPtr(myReplace) = False Then Exit Sub ElseIf myReplace = "" Then myRetry = MsgBox("No replacement string was entered." _ & vbCrLf & "The searched string will be deleted!" & vbCrLf _ & "Are you sure?", vbYesNoCancel + vbDefaultButton2 + _ vbExclamation, "Find and Comment") ElseIf myReplace = myFind Then myRetry = MsgBox("The replacement string must be different " & vbCrLf _ & "from the searched string.", vbRetryCancel + vbCritical, "Find and Comment") Else okInput = True End If If myRetry = vbYes Then okInput = True ElseIf myRetry = vbCancel Then Exit Sub End If Loop While okInput = False Do With Selection.find .Forward = True .ClearFormatting .MatchWholeWord = False .MatchCase = False .Wrap = wdFindContinue .Execute FindText:=myFind End With If Selection.Text = myFind Then Selection.Text = myReplace myContinue = True myCount = myCount + 1 ActiveDocument.Comments.Add Range:=Selection.Range, Text:="Replaces " & myFind Else myContinue = False End If Loop Until myContinue = False MsgBox myCount & " instances of '" & myFind _ & "' were found, replaced with '" & myReplace & _ "' and commented.", , "Find and Comment" End Sub