MS Word Macro to GoTo/Copy Highlighted Text 2

[djoliver1]

Hi, I'm trying to create a macro that can find highlighted text in a document, copy and paste it into another document. I don't know how to search for highlighted text with the FIND function, so I wasn't able to record a macro to discover the coding approach. Does anyone know how to do that?? Thanks in advance for any helpful suggestions.

More Detail:
Here's the answers to some questions that were asked by someone who suggested I needed to supply more detail:
1. Do you want to copy/paste ALL highlighted text? Ans: that is the end goal. I tend to highlight important text as I review documents and I wanted to automate the process of creating summary notes on what I read. So the final result of the macro would be all of the highlighted text in a new document, ready to be edited and saved.
2. Do you want to be able to pause and decide for each found highlight? Or do you want it to be fully automatic? Ans. Fully automatic. Afterwards, I could manually remove any redundancies from the notes doc.
3. Is it only words that will be highlighted? Or can it be chunks of words? Ans: Anything highlighted, meaning characters, punctuation, spaces. I assumed that a new line / paragraph (^p) could be inserted between each string of highlighted text.
4. Is the highlight all one colour, or can it different colours? Ans. It could capture all highlighting regardless of color.

 

[CautionMP]

Here is a starting point, this will find all highlighted text and output it to the Immediate pane of the VBE window.

[navy]Public Sub [/navy] FindHighlight()
[navy]Dim[/navy] myRange [navy]As[/navy] Range
[navy]Dim[/navy] lngRemainingLength [navy]As Long[/navy]
[navy]Dim[/navy] strHighlightText [navy]As String[/navy]

Set myRange = ActiveDocument.Range()
[green]'Get the Total Document length (characters)[/green]
lngRemainingLength = myRange.End
Do
  With myRange.Find
    .Highlight = [navy]True[/navy]
    .Execute ""
      [navy]If[/navy] .Found [navy]Then[/navy]
        [green]'Output the found text To the Immediate Window[/green]
        [green]'Add your code To write the found text To another Document[/green]
        Debug.Print myRange.Text
      [navy]End If[/navy]
  [navy]End[/navy] With
  [green]'Calculate the characters left after the current find[/green]
  lngRemainingLength = lngRemainingLength - myRange.End
  [green]'If there are no characters left Exit Loop, otherwise re-size range[/green]
  [navy]If[/navy] lngRemainingLength > 0 [navy]Then[/navy]
    Set myRange = ActiveDocument.Range(myRange.End, lngRemainingLength)
  Else
    [navy]Exit Do[/navy]
  [navy]End If[/navy]
Loop
[navy]End Sub [/navy]

Hope this helps,
CMP


(GMT-07:00) Mountain Time (US & Canada)

 

[fumei]

I am not quite following the purpose of the range resizing. In any case, here is a possible alternative. The following will take all highlight text - including phrases, not just individual words - and put them into a new document. Each found highlight (word(s), or phrases) is separated in the new document as a paragraph.

Sub MoveHighlights()
Dim ThisDoc As Word.Document
Dim ThatDoc As Word.Document
[COLOR=red]' make a document object of current doc[/color red]
Set ThisDoc = ActiveDocument
Selection.HomeKey Unit:=wdStory
[COLOR=red]' make a new document, and object[/color red]
Documents.Add
Set ThatDoc = ActiveDocument
[COLOR=red]' activate original doc and start search[/color red]
ThisDoc.Activate
With Selection.Find
  .ClearFormatting
  .Highlight = True
  Do While (.Execute(findtext:="", Forward:=True) _
      = True) = True
[COLOR=red]' while .Execute = True copy Selection
' and move it to new document, added paragraph mark[/color red]
    Selection.Copy
      ThatDoc.Activate
    Selection.Paste
    Selection.TypeParagraph
[COLOR=red]' then return to original doc[/color red]
      ThisDoc.Activate
  Loop
End With
[COLOR=red]' destroy document objects[/color red]
Set ThatDoc = Nothing
Set ThisDoc = Nothing
End Sub

Gerry

 

[fumei]

Never mind...I actually read it this time, and understand the resizing of the range. D'oh!

Gerry

 

[fumei]

CMP, just a quick question. Technically speaking, would it not be better to destroy the range object THEN do the new Set? If I understand correctly, the new Set instruction will actually allocate a new memory address block. This will leave the old one (each of them) still allocated until Set = Nothing. Does this not cause an accumulation of allocated memory address blocks? In other words, if the instruction loops through 50 times, there are 50 memory address blocks allocated, and persistent until Set = Nothing.

Or am I totally off kilter here? Not that it makes much of a difference I suppose, as each address block is not going to be all that large. However, I am curious.

Gerry

 

[fumei]

Something like:

Dim lngRemainingLength As Long
Dim lngRangeEnd As Long

* * * * * * * * * * * other code * * * *
  'Calculate the characters left after the current find
  lngRemainingLength = lngRemainingLength - myRange.End
[COLOR=red]' pick up range object End value
' and destroy the object[/color red]
  lngRangeEnd = myRange.End
  Set myRange = Nothing
  'If there are no characters left Exit Loop, otherwise re-size range
  If lngRemainingLength > 0 Then
[COLOR=red]' use previous value to make new range object[/color red]
    Set myRange = ActiveDocument.Range(lngRangeEnd, lngRemainingLength)
  Else
    Exit Do
  End If
* * * * * * * rest of code * * * * *

Gerry

 

[CautionMP]

When you re-assign the range the, the VBA engine SHOULD reuse the memory address without having to set it to [tt]Nothing()[/tt], but I know VBA is notorious for memory holes.

CMP

P.S. The [tt]Copy[/tt], [tt]Paste[/tt], and [tt]Activate [/tt] methods result in a performance hit. The code will run faster if you don't use them.

(GMT-07:00) Mountain Time (US & Canada)

 

[djoliver1]

Hey you guys. Thanks so much for the great input to my question. Both posts solve the problem and give me a lot to work with in understanding how to locate and manipulate highlighted text. Very cool. Thanks again.

 

[fumei]

P.S. The Copy, Paste, and Activate methods result in a performance hit. The code will run faster if you don't use them.

Agreed, but until the request for how to handle the found highlighted text is fully clarified...shrug...it is the easiest way to move the found highlights over, one by one. Performance wise, it would be better to identify them, THEN move them over en-masse. If you don't use them, what would you suggest? I could think of a couple of other ways, but I am interested in what you may suggest. You did not cover any processing of found text in your code.

Yes, it SHOULD reuse the address....but I don't believe it DOES.


Gerry

 

[CautionMP]

Hey,
Did anyone notice that I botched the Range selection? Corrected and streamlined code below.

fumei (Gerry),
Here is my approach to avoind the [tt]Cut/Paste/Activate[/tt] methods.

djoliver1,
I also made a couple of changes to make the code more reusable, for example you could add the following code to a small routine that cycles through a directory and process a whole batch of documents, if you needed to do something like that.

[navy]Public Sub [/navy] FindHighlight(SaveWithoutPrompt [navy]As Boolean[/navy], Optional SourceDocument [navy]As String[/navy])
On [navy]Error GoTo[/navy] Error_Handler
[navy]Dim[/navy] DocInput [navy]As [/navy]Document, DocOutput [navy]As Do[/navy]cument
[navy]Dim[/navy] myRange [navy]As[/navy] Range
[navy]Dim[/navy] lngSelectionStart [navy]As Long[/navy]

[green]'Check To see If source Document was supplied[/green]
[navy]If[/navy] SourceDocument = "" [navy]Then[/navy]
  [green]'No: So grab active Document[/green]
  [navy]Set[/navy] DocInput = ActiveDocument
[navy]Else[/navy]
  [green]'Yes: Then open that Document[/green]
  [navy]Set[/navy] docInput = Documents.Open(SourceDocument)
[navy]End If[/navy]

[green]'Create a new Document For output and add a header[/green]
[navy]Set[/navy] docOutput = [navy]Do[/navy]cuments.Add
docOutput.Range.Text = "Highlight Notes For " & DocInput.Name & vbCrLf

[green]'Initialize the start position[/green]
lngSelectionStart = 1

[navy]Do[/navy]
  [green]'Get the range from lngSelectionStart To End of the Document[/green]
  [navy]Set[/navy] myRange = docInput.Range(lngSelectionStart, docInput.Characters.Count)
  [navy]With[/navy] myRange.Find
    .Highlight = [navy]True[/navy]
    .Execute ""
      [navy]If[/navy] .Found [navy]Then[/navy]
        [green]'If the item is found, write it To the output Document[/green]
        docOutput.Range.Text = docOutput.Range.Text & vbLf & myRange.Text
      [navy]End If[/navy]
  [navy]End With[/navy]
  [green]'Move the start 1 character past the last End[/green]
  lngSelectionStart = myRange.End + 1
  [green]'Clear the range since we Don't know If it is a memory hole[/green]
  [navy]Set[/navy] myRange = [navy]Nothing[/navy]
[navy]Loop Until[/navy] lngSelectionStart >= docInput.Characters.Count

[navy]With[/navy] docOutput
  [green]'Check If we need To prompt For output file name[/green]
  [navy]If[/navy] SaveWithoutPrompt [navy]Then[/navy]
    [green]'No: Add 'Highlights - ' To the existing Document name[/green]
    .SaveAs "Highlights - " & docInput.Name
  [navy]Else[/navy]
    [green]'Yes: Ask For a new file name, default To above[/green]
    .SaveAs InputBox("Please enter file name:", "SaveAs", "Highlights - " & docInput.Name)
  [navy]End If[/navy]
  .Close [navy]False[/navy]
[navy]End With[/navy]

Error_Handler:
[navy]Select Case[/navy] Err.Number
  [navy]Case[/navy] 0
    [green]'No Error, Do Nothing[/green]
  [navy]Case[/navy] 5152
    [green]'User canceled the [green]'SaveAs[green]' prompt[/green]
    Err.Clear
    [navy]Resume Next[/navy]
  [navy]Case Else[/navy]
    MsgBox Err.Number & " " & Err.Description, vbOKOnly, "FindHighlight Error"
[navy]End Select[/navy]

CleanUP:
[navy]Set[/navy] myRange = [navy]Nothing[/navy]
[navy]Set[/navy] docInput = [navy]Nothing[/navy]
[navy]Set[/navy] docOutput = [navy]Nothing[/navy]
[navy]End Sub [/navy]

Sorry about botching the [tt]Range()[/tt] selection,
CMP

(GMT-07:00) Mountain Time (US & Canada)

 

[djoliver1]

I noticed that when I ran CautionMP's code I got an error, although stepping through it I could see that it was capturing and writing highlighted text to the Immediate Window as designed. That error seemed to disappear when I pasted in Gerry's first suggestion to Set myrange = nothing. Maybe that was just coincidence.

Otherwise, you guys are going way to fast for me. It's a great conversation but it will take time for me to digest it. Thanks again for the great input from both of you. I've got hundreds of pages of RFPs to read through and it will be great afterwards to collect my highlighted excerpts automatically rather than manually. You made my day!

One more question: what is a good source for information such as how Word handles highlights and how to manipulate them. About 12 years ago I used to do a little WordBasic work (just before VBA came out) and at that time there was a good publication that covered MS Word under the covers so to speak. Is there anything published today that you would recommend?

 

[djoliver1]

Hey CMP, I just noticed that your last post removed the write to the Immediate Window and added code to write to a new or existing document. That's great since I wasn't sure how I was going to copy from the immediate window to write to a word doc. I haven't tried it yet, but I'll let you know how it goes. Great stuff. Thanks again.

 

[CautionMP]

Beleive it or not I know next to nothing about Word macros. I'm drawing on 10+ years of extensive macro development in both Access and Excel and suplement it with information from the Word help files.

But back to your question.

Sources of information (great intentionally left out):[ul][li]The Help Files[/li][li]The Object Browser[/li][li]MSDN[/li][/ul]

Sources of great information:[ul][li]Books from WROX have worked great for me.[/li][li]Tek-Tips someone always has a different approach when I'm stumped, or has already done it.[/li][/ul]

Hope this helps,
CMP
[small]P.S. I answered this post because I made a bid recently to do a job in Word and I need the practice.[/small]



(GMT-07:00) Mountain Time (US & Canada)

 

[djoliver1]

Good luck with the Word job. That application used to be full of bugs, which were the bane of Word developers. Maybe things are better now. I checked and WROX doesn't seem to have a book on VBA Word. I used to use an MS Word SDK, but that doesn't exist anymore either. Help files don't usually have enough info to help hacks like me. Tek-Tips is a great resource though. I'm glad I heard about it. Especially, the VBA forum seems to have a lot of depth.

 

[fumei]

Actually, I don't quite agree re: Help. Help in VBA is fairly decent, and is a big source of info.

As for books, there are two that are possibly out of print, but if you can find them in second places, or remainder places, they are very yseful.

Word 2000 Developer Handbook - while deals with Word 2000, the vast majority of it still applies.

VBA Developer Handbook

Both are printed by Sybex.

MSDN is always good.

The Object Browser, once you get to know how to sniff around in it is very handy. Although there quite a few things in Word that you can not actually get information on in the Object Browser...believe it or not.

CMP...nice one!

Gerry

 

[BenRowe]

I noticed your posting in the Microsoft Office forum. There is a way of doing this in word without needing a macro. I know this works in word 2003 and perhaps in prior versions too.
1. Ctrl + F -- brings us Find dialog
2. Click in Find What
3. Click on down arrow next to Format (near bottom of dialog) and click Highlight
4. Click Highlight all items found in (main document).
5. Click Find All
6. All information in document that is highlighted is now selected so you can do a copy and then paste them into a new doc.

 

[Gavona]

Unfortunately, Ben, step 4 isn't available in Word97 - you can only step through one at a time. As I now have Office2003 I am grateful to you for pointing me at another little bit of enhanced functionality.



Gavin

 

[djoliver1]

Thanks BenRowe. That's good to know for future reference.