Sub URLlinker()
' Paul Beverley - Version 05.03.24
' Finds all URLs in the text and links them

Set rng = ActiveDocument.Range
With rng.Find
  .Text = "^$.^$"
  .Replacement.Text = ""
  .Wrap = wdFindStop
  .Forward = True
  .MatchWildcards = False
  .Execute
End With

Do While rng.Find.Found = True
  Do While InStr(vbCr & " ", Right(rng.Text, 1)) = 0
    rng.MoveEnd , 1
    DoEvents
  Loop
  rng.MoveEnd , -1
  If rng.Characters.Last = "." Then rng.MoveEnd , -1

  Do While InStr(vbCr & " ", Left(rng.Text, 1)) = 0
    rng.MoveStart , -1
    DoEvents
  Loop
  rng.MoveStart , 1

  myAddress = rng.Text
  rng.Text = Replace(rng.Text, "https://", "")
  rng.Text = Replace(rng.Text, "http://", "")
  Set myLink = ActiveDocument.Hyperlinks.Add(Anchor:=rng, _
        Address:=myAddress, TextToDisplay:=rng.Text)
  rng.Start = myLink.Range.End
  rng.End = ActiveDocument.Content.End
  rng.Find.Execute
  DoEvents
  rng.Select
Loop
Selection.Collapse wdCollapseEnd
Beep
End Sub