Find and select a passive URL string

gmaxey · #16 11-14-2025, 09:36 AM

Quote:

Originally Posted by RobiNew

Many thanks, gmaxey! Your code returns an error on "bFound = .Execute"
and the message reads:
Run-time error '5560'
The Find What text contains an invalid expression.
Use search criteria

Robinew,

I suspect that is because of where you live (or your regional settings). Try:

Code:

Sub SelectNextURL()
Dim oDoc As Document, oRng As Range
Dim bFound As Boolean
Dim strLS As String
  strLS = Application.International(wdListSeparator)
  Set oDoc = ActiveDocument
  Set oRng = oDoc.Range
  With oRng.Find
    .ClearFormatting
    .Text = ""
    .MatchWildcards = True
    'Word wildcards: http[s]:// followed by any non-space characters
    .Text = "(http*)(://*)([! ^13^32^9^t<>'""]{1" & strLS & "})"
    bFound = .Execute
  End With
  If bFound Then
    oRng.Select
    MsgBox "URL found and selected: " & oRng.Text, vbInformation
  Else
    MsgBox "No URL found.", vbExclamation
  End If
lbl_Exit:
  Exit Sub
End Sub

or simplified:

Code:

Sub SelectNextURL()
Dim oDoc As Document, oRng As Range
Dim strLS As String
  strLS = Application.International(wdListSeparator)
  Set oDoc = ActiveDocument
  Set oRng = oDoc.Range
  With oRng.Find
    .ClearFormatting
    .Text = ""
    .MatchWildcards = True
    'Word wildcards: http[s]:// followed by any non-space characters
    .Text = "(http*)(://*)([! ^13^32^9^t<>'""]{1" & strLS & "})"
    If .Execute Then
      oRng.Select
      MsgBox "URL found and selected: " & oRng.Text, vbInformation
    Else
      MsgBox "No URL found.", vbExclamation
    End If
  End With
lbl_Exit:
  Exit Sub
End Sub

RobiNew · #17 11-14-2025, 10:28 AM

That's great! Thank you, gmaxey. Your simplified version works perfectly. I thought we'd never find a solution. All the best!

RobiNew · #18 11-16-2025, 02:47 AM

Hi! Now I am trying to use the code posted by gmaxey in a loop, but it doesn't work because this line "oRng.Collapse Direction:=wdCollapseEnd" remains inactive. Here is the code (I'm using the # button, but it doesn't seem to work):
Sub HTTP_Loop()
Dim oRng As Range
Dim oPar As Paragraph
Dim SearchString As String
Dim strLS As String
strLS = Application.International(wdListSeparator)
Set oRng = ActiveDocument.StoryRanges(wdMainTextStory)
SearchString = "(http*)(://*)([! ^13^32^9^t<>'""]{1" & strLS & "})"
With oRng.Find
.MatchWildcards = True
Do While .Execute(FindText:=SearchString, Forward:=True) = True
oRng.Select
MsgBox "Continue with [OK]."
If oRng.Characters.Last Like "[,.:

]" Then
oRng.MoveEnd Unit:=wdCharacter, Count:=-1
End If
ActiveDocument.Hyperlinks.Add Anchor:=oRng, Address:=oRng.Text, _
SubAddress:="", ScreenTip:="", TextToDisplay:=oRng.Text
oRng.Collapse Direction:=wdCollapseEnd
oRng.Select
Loop
End With
End Sub

gmaxey · #19 11-16-2025, 03:36 AM

Paul has already shown you how to make hyperlinks the the AutoFormat method:

Code:

Sub HTTP_Loop()
Dim oRng As Range
Dim strLS As String
  strLS = Application.International(wdListSeparator)
  Set oRng = ActiveDocument.StoryRanges(wdMainTextStory)
  With oRng.Find
    .MatchWildcards = True
    .Text = "(http*)(://*)([! ^13^32^9^t<>'""]{1" & strLS & "})"
    .Forward = True
    While .Execute
      oRng.Select
      If MsgBox("Continue ...", vbOKCancel, "Processing") = vbOK Then
        If oRng.Characters.Last Like "[,.:]" Then oRng.MoveEnd wdCharacter, -1
        oRng.Duplicate.AutoFormat
        oRng.Collapse wdCollapseEnd
      End If
    Wend
  End With
End Sub

However the problem with your code is simply collapsing the range after adding a hyperlink as you have done leaves the range inside the resulting field at a point where the string can be found over and over again. You will have to get the range out of the field.

Code:

Sub HTTP_Loop()
Dim oRng As Range, oHL As Hyperlink
Dim strLS As String
  strLS = Application.International(wdListSeparator)
  Set oRng = ActiveDocument.StoryRanges(wdMainTextStory)
  With oRng.Find
    .MatchWildcards = True
    .Text = "(http*)(://*)([! ^13^32^9^t<>'""]{1" & strLS & "})"
    .Forward = True
    While .Execute
      oRng.Select
      If MsgBox("Continue ...", vbOKCancel, "Processing") = vbOK Then
        If oRng.Characters.Last Like "[,.:]" Then oRng.MoveEnd wdCharacter, -1
        Set oHL = ActiveDocument.Hyperlinks.Add(Anchor:=oRng.Duplicate, Address:=oRng.Text, _
          SubAddress:="", ScreenTip:="", TextToDisplay:=oRng.Text)
        oRng.Start = oHL.Range.End
        'Or
        'oRng.Collapse wdCollapseEnd
        'oRng.MoveStart wdCharacter, 1
      End If
    Wend
  End With
End Sub

RobiNew · #20 11-16-2025, 04:33 AM

Thanks a lot, gmaxey, for the code and the explanations. I prefer the two lines 'oRng.Collapse wdCollapseEnd and 'oRng.MoveStart wdCharacter, 1.
I cannot adopt the AutoFormat method (my thanks to Paul!), because in my complex macro the "TextToDisplay:=" in hyperlinks varies.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Find string, Replace with dot tab	dhapp	Word	5	03-27-2023 07:23 AM
Find and select all string of simlar pattern	anon123	Word	4	04-20-2016 11:41 PM
How to find all string within string.	PRA007	Word VBA	18	02-12-2016 08:11 PM
Why is this Find string not working	TechEd	Word VBA	5	07-05-2014 08:12 PM
Bad view when using Find and Find & Replace - Word places found string on top line	paulkaye	Word	4	12-06-2011 11:05 PM