Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
Dim lngHL As Long
  Selection.Find.ClearFormatting
  Selection.Find.Replacement.ClearFormatting
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = "^p"
    .Style = "Hyperlink"
    While .Execute
      oRng.Select
      Selection.ClearCharacterAllFormatting
      For lngHL = oRng.Paragraphs(1).Range.Hyperlinks.Count To 1 Step -1
        oRng.Paragraphs(1).Range.Hyperlinks(lngHL).Delete
      Next lngHL
      oRng.Collapse wdCollapseEnd
    Wend
 End With
lbl_Exit:
  Exit Sub
End Sub

Sub ReapplyHyperlinksWithoutRemovingText1()
    Dim doc As Document
    Dim hl As hyperlink
    Dim hlRange As Range
    Dim hlText As String
    Dim startPos As Long
    Dim endPos As Long
    Dim i As Long
    Dim hlAddress As String
    Dim hlSubAddress As String
    Dim partRange As Range
    
    Set doc = ActiveDocument
    
    ' Loop through each hyperlink in the document
    For Each hl In doc.Hyperlinks
        Set hlRange = hl.Range
        hlText = hlRange.Text
        startPos = hlRange.Start
        endPos = hlRange.End
        hlAddress = hl.Address
        hlSubAddress = hl.SubAddress
        
        ' Check if the hyperlink text contains a paragraph break
        If InStr(hlText, vbCr) > 0 Or InStr(hlText, vbLf) > 0 Then
            ' Remove the hyperlink
            hl.Delete
            
            ' Split the text by paragraph breaks
            Dim parts() As String
            parts = Split(hlText, vbCr)
            
            ' Reapply hyperlink to the first part only
            If parts(0) <> "" Then
                Set partRange = doc.Range(startPos, startPos + Len(parts(0)))
                partRange.Hyperlinks.Add _
                    Anchor:=partRange, _
                    Address:=hlAddress, _
                    SubAddress:=hlSubAddress, _
                    TextToDisplay:=parts(0)
            End If
        End If
    Next hl
End Sub