Solved: Word: Find and add Comment Macro

[mddenapoli]

Greetings,

I have been working as an technical editor and spend a lot of time adding comments to documents I recieve. I'm a bit of a novice and would like to know if there is a way to improve the macro or vbscript (below) I found this on the web but it is very slow and I dont know enough to improve upon it. Can anyone help?

Public Sub addComments()
Dim intCount As Integer
Dim strSearch As String
Dim strComment As String
Dim intDiff As Integer

strSearch = InputBox("Please enter the word to search for:", "Search")
strComment = InputBox("Please enter the comment you wish to add to all instances of [" & strSearch & "].", "Search")

For intCount = 1 To ActiveDocument.Words.Count
With ActiveDocument
If (LCase(Trim(.Words(intCount).Text)) = strSearch) Then
intDiff = Len(.Words(intCount).Text) - Len(Trim(.Words(intCount).Text))
'.Words(intCount).Font.Italic = True
.Comments.Add .Range(.Words(intCount).Start, (.Words(intCount).End - intDiff)), strComment

'Uncomment the lines below to add event handling while process is running
'If (intCount Mod 2) = 1 Then
' DoEvents
'End If
End If
End With
Next

End Sub

Public Sub remComments()
Dim intCount As Integer
For intCount = 1 To ActiveDocument.Comments.Count
ActiveDocument.Comments(1).Delete
Next
End Sub

[Paul_Hossler]

Thanks for the idea. I think I can use that concept also

This is what I came up with, by modifying some code that others on VBX helped me with. It could probably be tightened up some, but .Find is something I'm still learning how to best use.

This seems to work OK on my test doc ... so far

[vba]
Sub Add_Comments()
Dim strSearch As String
Dim strComment As String

Dim aDoc As Document
Dim AllRng As Range
Dim SrchRng As Range

strSearch = InputBox("Please enter the word to search for:", "Search: Leave blank to Exit")
If Trim(Len(strSearch)) = 0 Then Exit Sub

strComment = InputBox("Please enter the comment you wish to add to all instances of [" & strSearch & "].", "Search: Leave blank to Exit")
If Trim(Len(strComment)) = 0 Then Exit Sub

strSearch = Trim(strSearch)
strComment = Trim(strComment)

Set aDoc = ActiveDocument
Set AllRng = aDoc.Range
Set SrchRng = AllRng.Duplicate

Do
With SrchRng.Find
.ClearFormatting
.Text = strSearch
.MatchCase = False ' seems reasonable
.MatchWholeWord = True ' seems reasonable
.Execute
End With

If SrchRng.Find.Found Then Call aDoc.Comments.Add(SrchRng, strComment)
Loop Until Not SrchRng.Find.Found

End Sub
Public Sub Remove_Comments()
Dim intCount As Integer
For intCount = 1 To ActiveDocument.Comments.Count
ActiveDocument.Comments(1).Delete
Next
End Sub
[/vba]

Paul

[mddenapoli]

Paul,

Thank you very much. I will test this on some of the documents I review tonight. I think that this script coupled with the extract comment script posted on "DocTools" that extracts comments in addition to a few more will make a supurb editors toolbar. Ultimately that is my goal, due to the volume and utter redundancy of the work, I hope that I can make it so easy its embarrasing. Also, I found a script that saves a copy of the document with a version number and date. I will post it later tonight!

[fumei]

Could you PLEASE use the underscore character to break up code lines? Otherwise it makes the code window ridiculously wide.

Example (please compare to the original above)
[vba]
strComment = InputBox("Please enter the comment you " & _
"wish to add to all instances of [" & strSearch & "].", _
"Search: Leave blank to Exit")

[/vba]
Thanks.

[mddenapoli]

Where would you put that within the code? Be gentle Im a newbie!

[Paul_Hossler]

I think fumei was talking to me ...

Sorry, bad habit of pasting the lines as in the VBE

I try to do a preview, and they looked OK to me then, with only a bit trailing off the right on one line that didn't seem to detract from the code


Paul

[fumei]

Yes, i was talking to Paul. On my screen, of:

strComment = InputBox("Please enter the comment you wish to add to all instances of [" & strSearch & "].", "Search: Leave blank to Exit")

I see:

strComment = InputBox("Please enter the comment you wish to add to al

Essentially the code window is twice as wide as my screen, so I have to scroll both up and down AND left and right. It makes it a pain to read.

Paul, could you do me a favor? Can you go back into your post and add underscores? I would appreciate it.

[Paul_Hossler]

No problem, but I can't see any edit button or anything that allows me to edit the VBA. I could always repost it, but I don't think that will do anything at this point.

Let me know how to do the edit to add the under scores and I'll fix my post.

FWIW, the entire line w/o underscores fits on my monitor without L-R scrolling, and your's with the underscores only covers 40% of the available VBA: sub window width, so I guess I didn't think about breaking the lines since it looked OK on mine.

I will try to remember to accomidate

Paul

[fumei]

You must be using a much higher screen resolution, which is fine...for you. I am NOT trying to be critical, but it is an assumption that is unfortunately becoming all too common.

I see userforms in documents that I can not see any of the commandbuttons because the person made the darn thing so big that I can not get the whole userform on screen. Which means it is essentially useless for me.

"FWIW, the entire line w/o underscores fits on my monitor without L-R scrolling, and your's with the underscores only covers 40% of the available VBA: sub window width"

Mine (with the underscores) covers about 80% of the code window on my monitor at 1024 x 768. This is our corporate standard, and can NOT be changed (the screen settings dialog is disabled for all of our users...including me).

[Paul_Hossler]