find and copy all highlights of a particular color

Hi all.

I'm working with a long document in which "glossary" words have all
been highlighted bright green. I would like to copy all of these words
into a separate document so that I can create the glossary.

I'm sure that Word has built-in features that would be a better choice
for this task, but I have to remain within this particular scheme, so
I'm just trying to make my job a little easier.

I have an old WordBasic macro that finds all the occurences of a
particular text string and appends them into a text document, one by
one, but I can't quite figure out how to do the same in VBA and then
modify the search, and I don't think WordBasic supports a search for a
particular highlight color.

Can anyone point me in the right direction?

Thanks.

Rodney

Greg
Sat May 07 13:08:18 CDT 2005

Rodney

See if replacing the msgbox line in the below code with your code to append
to a text document will work:

Sub ScratchMacro1()
Dim rngstory As Word.Range
Set rngstory = ActiveDocument.Range
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = False
.MatchWholeWord = True
.Wrap = wdFindStop
.Highlight = True
While .Execute
If rngstory.HighlightColorIndex = wdBrightGreen Then
MsgBox rngstory
End If
Wend
End With
End Sub


--
Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.

Rodney Atkins wrote:
> Hi all.
>
> I'm working with a long document in which "glossary" words have all
> been highlighted bright green. I would like to copy all of these words
> into a separate document so that I can create the glossary.
>
> I'm sure that Word has built-in features that would be a better choice
> for this task, but I have to remain within this particular scheme, so
> I'm just trying to make my job a little easier.
>
> I have an old WordBasic macro that finds all the occurences of a
> particular text string and appends them into a text document, one by
> one, but I can't quite figure out how to do the same in VBA and then
> modify the search, and I don't think WordBasic supports a search for a
> particular highlight color.
>
> Can anyone point me in the right direction?
>
> Thanks.
>
> Rodney

Rodney
Sat May 07 16:32:44 CDT 2005

Greg:

Well, something happened, but I'm not sure quite what. I got another
file, but it had only an odd collection of characters:

[Hard Return]
{14 spaces}[Hard Return]
[Hard Return]
[Box Character][Hard Return]

About 2 and half pages of that, repeated.

Here's the macro all in one piece. Note that I have not bothered to
change the wordbasic portions.

Sub ScratchMacro1()
Dim file$
Dim dot
Dim prefix$

Dim rngstory As Word.Range
Set rngstory = ActiveDocument.Range

Rem Get the current path and filename and change extension to '.gls'
Rem
file$ = WordBasic.[FileName$]()
dot = InStr(file$, ".")
If dot > 1 Then
prefix$ = WordBasic.[Left$](file$, dot - 1)
Else
prefix$ = file$
End If
file$ = prefix$
file$ = LCase(file$) + ".gls"

With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = False
.MatchWholeWord = True
.Wrap = wdFindStop
.Highlight = True
While .Execute
If rngstory.HighlightColorIndex = wdBrightGreen Then
Open WordBasic.[CleanString$](file$) For Append As 1
Print #1, WordBasic.[Selection$](), Chr(13)
Close 1
End If
Wend
End With
End Sub


On Sat, 7 May 2005 14:08:18 -0400, "Greg Maxey"
<gmaxey@mvps.OscarRomeoGolf> wrote:

>Rodney
>
>See if replacing the msgbox line in the below code with your code to append
>to a text document will work:
>
>Sub ScratchMacro1()
>Dim rngstory As Word.Range
>Set rngstory = ActiveDocument.Range
>With rngstory.Find
> .ClearFormatting
> .Replacement.ClearFormatting
> .MatchWildcards = False
> .MatchWholeWord = True
> .Wrap = wdFindStop
> .Highlight = True
> While .Execute
> If rngstory.HighlightColorIndex = wdBrightGreen Then
> MsgBox rngstory
> End If
> Wend
>End With
>End Sub

Greg
Sat May 07 17:46:03 CDT 2005

Rodney,

I don't have a clue about wordbasic. I never used it. I dug around in the
VBA help file and stumbled on a WriteLine process. You want a text file
with the list of your hightlighted words correct? This seems to work:

Sub ScratchMacro1()
Dim fs
Dim wordLog
Set fs = CreateObject("Scripting.FileSystemObject")
Set wordLog = fs.CreateTextFile("c:\testfile.txt", True)
Dim rngstory As Word.Range
Set rngstory = ActiveDocument.Range
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = False
.MatchWholeWord = True
.Wrap = wdFindStop
.Highlight = True
While .Execute
If rngstory.HighlightColorIndex = wdBrightGreen Then
wordLog.WriteLine rngstory
End If
Wend
End With
wordLog.Close
End Sub

--
Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.

Rodney Atkins wrote:
> Greg:
>
> Well, something happened, but I'm not sure quite what. I got another
> file, but it had only an odd collection of characters:
>
> [Hard Return]
> {14 spaces}[Hard Return]
> [Hard Return]
> [Box Character][Hard Return]
>
> About 2 and half pages of that, repeated.
>
> Here's the macro all in one piece. Note that I have not bothered to
> change the wordbasic portions.
>
> Sub ScratchMacro1()
> Dim file$
> Dim dot
> Dim prefix$
>
> Dim rngstory As Word.Range
> Set rngstory = ActiveDocument.Range
>
> Rem Get the current path and filename and change extension to '.gls'
> Rem
> file$ = WordBasic.[FileName$]()
> dot = InStr(file$, ".")
> If dot > 1 Then
> prefix$ = WordBasic.[Left$](file$, dot - 1)
> Else
> prefix$ = file$
> End If
> file$ = prefix$
> file$ = LCase(file$) + ".gls"
>
> With rngstory.Find
> .ClearFormatting
> .Replacement.ClearFormatting
> .MatchWildcards = False
> .MatchWholeWord = True
> .Wrap = wdFindStop
> .Highlight = True
> While .Execute
> If rngstory.HighlightColorIndex = wdBrightGreen Then
> Open WordBasic.[CleanString$](file$) For Append As 1
> Print #1, WordBasic.[Selection$](), Chr(13)
> Close 1
> End If
> Wend
> End With
> End Sub
>
>
> On Sat, 7 May 2005 14:08:18 -0400, "Greg Maxey"
> <gmaxey@mvps.OscarRomeoGolf> wrote:
>
>> Rodney
>>
>> See if replacing the msgbox line in the below code with your code to
>> append to a text document will work:
>>
>> Sub ScratchMacro1()
>> Dim rngstory As Word.Range
>> Set rngstory = ActiveDocument.Range
>> With rngstory.Find
>> .ClearFormatting
>> .Replacement.ClearFormatting
>> .MatchWildcards = False
>> .MatchWholeWord = True
>> .Wrap = wdFindStop
>> .Highlight = True
>> While .Execute
>> If rngstory.HighlightColorIndex = wdBrightGreen Then
>> MsgBox rngstory
>> End If
>> Wend
>> End With
>> End Sub

Rodney
Sun May 08 10:26:29 CDT 2005

That works!

Thanks.

On Sat, 7 May 2005 18:46:03 -0400, "Greg Maxey"
<gmaxey@mvps.OscarRomeoGolf> wrote:

>Rodney,
>
>I don't have a clue about wordbasic. I never used it. I dug around in the
>VBA help file and stumbled on a WriteLine process. You want a text file
>with the list of your hightlighted words correct? This seems to work:
>
>Sub ScratchMacro1()
>Dim fs
>Dim wordLog
>Set fs = CreateObject("Scripting.FileSystemObject")
>Set wordLog = fs.CreateTextFile("c:\testfile.txt", True)
>Dim rngstory As Word.Range
>Set rngstory = ActiveDocument.Range
>With rngstory.Find
> .ClearFormatting
> .Replacement.ClearFormatting
> .MatchWildcards = False
> .MatchWholeWord = True
> .Wrap = wdFindStop
> .Highlight = True
> While .Execute
> If rngstory.HighlightColorIndex = wdBrightGreen Then
> wordLog.WriteLine rngstory
> End If
> Wend
> End With
> wordLog.Close
> End Sub