Solved: Loop/Search and Insert Hyperlinks

[wdorciak]

I am trying to create a macro to search for multiple occurences of a string and insert hyperlink based on the found string.

The search and loop portion is working fine, however when I activate the Add hyperlink piece, it will get stuck on the first string it finds, converts that to hyperlink, and does not go any further. It just keeps finding the same string over and over.

I think I need to do something to extend/redefine the range, not sure how to do that.

Sub InsertLinks()
Dim r As Range
Dim SearchString As String

Set r = ActiveDocument.Range
SearchString = "P&P????"
With r.Find
.MatchWildcards = True
Do While .Execute(findText:=SearchString, Forward:=True) = True
r.Select
MsgBox (r.Text)
'ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, _
'Address:=Replace(r.Text, " ", ""), SubAddress:="", ScreenTip:="", 'TextToDisplay:=r.Text
Loop
End With
End Sub

Thanks, Walter.

[fumei]

Add a Collapse. This is why it keeps getting the same string. You need to Collapse to the end so it can continue.

Sub InsertLinks()
Dim r As Range
Dim SearchString As String

Set r = ActiveDocument.Range
SearchString = "P&P????"
With r.Find
.MatchWildcards = True
Do While .Execute(findText:=SearchString, Forward:=True) = True
r.Select
MsgBox (r.Text)
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, _
Address:=Replace(r.Text, " ", ""), SubAddress:="", ScreenTip:="", 'TextToDisplay:=r.Text
r.Collapse 0 ' 0 = wdCollapsend
Loop
End With
End Sub

[wdorciak]

Hm, I tried that, and it still keeps going to the first occurence of the string.

When I step through the macro, I can see the text deselected, then it comes back to it.

Or is it finding the hyperlink at that point?

Thanks, Walter.

[fumei]

Perhaps not use Selection?? You are using a range Find, so why are you using a Selection range for this?
Sub InsertLinks()
Dim r As Range
Dim SearchString As String

Set r = ActiveDocument.Range
SearchString = "P&P????"
With r.Find
.MatchWildcards = True
Do While .Execute(findText:=SearchString, Forward:=True) = True
ActiveDocument.Hyperlinks.Add Anchor:=r, _
Address:=Replace(r.Text, " ", ""), SubAddress:="", ScreenTip:="", 'TextToDisplay:=r.Text
r.Collapse 0 ' 0 = wdCollapsend
Loop
End With
End Sub

[wdorciak]

Was not aware I could do that (just getting into VBA in Word 2007).

Trying now...

Still does the same thing :confused:

Thank you.

[fumei]

Post your exact code.

[wdorciak]

Here is the code and a test document.

Really appreciate your help.

Sub InsertLinks()
Dim r As Range
Dim SearchString As String

Set r = ActiveDocument.Range
SearchString = "P&P????"
With r.Find
.MatchWildcards = True
Do While .Execute(findText:=SearchString, Forward:=True) = True
MsgBox (r.Text)
ActiveDocument.Hyperlinks.Add Anchor:=r, Address:=Replace(r.Text, " ", ""), SubAddress:="", ScreenTip:="", TextToDisplay:=r.Text
r.Collapse 0

Loop
End With
End Sub

[fumei]

Hang on, I am having a stupid moment...

[fumei]

Well darn.

[fumei]

OK, try this:

Sub InsertLinks()
Dim r As Range
Dim SearchString As String

Set r = ActiveDocument.Range
SearchString = "P&P????"
With r.Find
.MatchWildcards = True
Do While .Execute(findText:=SearchString, Forward:=True) = True
ActiveDocument.Hyperlinks.Add Anchor:=r, _
Address:=Replace(r.Text, " ", ""), _
SubAddress:="", ScreenTip:="", TextToDisplay:=r.Text
With r
.Expand Unit:=wdParagraph
.Collapse 0
End With
Loop
End With
End Sub
This will ONLY work if the search string "P&P????" is at the end of the paragraph. In your demo they are, but will this always be the case??

The problem is that the Found of the range - P&P???? - is converted into a hyperlink field. Technically this is { HYPERLINK P&P211 }. Thus - technically - the existing .End of the range is INSIDE that field, not at the end.

So, I expanded the range to be the whole sentence, THEN Collapsed it. And so it continues.

Click "Insert Links" on the top toolbar. Your hyperlinks are created. Mind you, as it stands these hyperlinks are useless, as they do not point to anything. You have the Address as:

Address:=Replace(r.Text, " ", "")

which turns into P&P211, which points to nothing but an error.

[wdorciak]

I have this working using 'With Selection.Find', however I thought it would be cleaner with Range. The whole document scrolls and highlights..

Maybe I could just turn the updates off, there was a command to do that.

Regards, Walter.

[fumei]

Notice the code does not use Selection at all.

[fumei]

Better version.

Sub InsertLinks()
Dim r As Range
Dim SearchString As String

Set r = ActiveDocument.Range
SearchString = "P&P????"
With r.Find
.MatchWildcards = True
Do While .Execute(findText:=SearchString, Forward:=True) = True
ActiveDocument.Hyperlinks.Add Anchor:=r, _
Address:=Replace(r.Text, " ", ""), _
SubAddress:="", ScreenTip:="", TextToDisplay:=r.Text
With r
.End = r.Hyperlinks(1).Range.End
.Collapse 0
End With
Loop
End With
End Sub
I made the range End = the hyperlink range End, and then collapsed it. Thus it does not use anything with the paragraph, and thus your search string Found can be anywhere.

But again, your Hyperlink Address are useless.

[fumei]

BTW: if anyone wants to see for themselves, add a messagebox before and after the hyperlink creation, displaying the range .Start and End.

At Found: 324 331
After: Hyperlink 324 347

Difference = 16

The field is { HYPERLINK "P&P211" } - 22 characters

P&P211 = 6 characters

Difference? 16 characters.

[Tinbendr]

You could work backwards through the document.

Sub InsertLinksTB()
Dim Rng As Range
Dim SearchString As String

Set Rng = ActiveDocument.Range
SearchString = "P&P????"
With Rng.Find
.MatchWildcards = True
Do While .Execute(findText:=SearchString, Forward:=False) = True
ActiveDocument.Hyperlinks.Add Anchor:=Rng, _
Address:=Replace(Rng.Text, " ", ""), _
SubAddress:="", ScreenTip:="", TextToDisplay:=Rng.Text
Rng.Collapse wdCollapseStart
Rng.Select: Stop 'for testing
Loop
End With
End Sub

[wdorciak]

Thanks for all your help.

Good point about hyperlinks. I forgot to add .pdf at the end, so it becomes P&P999.pdf.

We use hyperlink base of ~/, the PDFs are published to our Intranet, and the browser substitutes current virtual directory path, so it becomes http://server/virtual_dir/P&P999.pdf.

PDFs link to each other in the same virtual directory, so it is working out OK.

Regards, Walter.

[fumei]

Tinbendr, good one.

[wdorciak]

Final version of the macro.
Thanks again, Walter.

Sub InsertLinks()

Dim r As Range
Dim strPrefixes() As String
Dim LoopVar As Integer

Application.ScreenUpdating = False

strPrefixes = Split("P&P [0-9]{3}>|STD-[0-9]{2}>|...", "|")
ActiveDocument.BuiltInDocumentProperties(wdPropertyHyperlinkBase) = "~/"

For LoopVar = 0 To UBound(strPrefixes())

Set r = ActiveDocument.Range

With r.Find
.MatchWildcards = True
.Forward = False
.Text = strPrefixes(LoopVar)
Do While .Execute() = True
ActiveDocument.Hyperlinks.Add Anchor:=r, Address:=Replace(r.Text, " ", "") & ".pdf", SubAddress:="", ScreenTip:="", TextToDisplay:=r.Text
With r
r.Collapse wdCollapseStart
End With
Loop
End With
Next LoopVar

Application.ScreenUpdating = True
MsgBox ("Macro completed")
End Sub

[timdata]

Hi, I'm trying to do a similar search in a Word document identified as "BM1010_" and find the following three types of document references to insert relative hyperlinks:

BM1010.01
BM1010.01.02
BM1010.01.02.03

The 1st type relative hyperlink will to need give the following result (for the three document references):

01.pdf
0102.pdf
010203.pdf

The 2nd type of relative hyperlink will need to point an external document, such as:

BM2020.01.02.03

The resulting hyperlink should be:
../BM2020/010203.pdf

Can you provide a similar VBA code that can do this? :bow: