View Single Post
 
Old 11-16-2025, 03:36 AM
gmaxey gmaxey is offline Windows 10 Office 2019
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,636
gmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nice
Default

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
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote