Sub ListAllLinks()
' Paul Beverley - Version 31.01.25
' Creates a table of all URLs in the file

deleteTableBorders = True

Set thisDoc = ActiveDocument
If Selection.End = Selection.start Then
  myResponse = MsgBox("List links in the WHOLE file?", _
       vbQuestion + vbYesNo)
  If myResponse = vbNo Then Exit Sub
  Set rngSource = ActiveDocument.Content
Else
  Set rngSource = Selection.Range.Duplicate
End If
Set listDoc = Documents.Add
Set rng = listDoc.Content

For Each lnk In rngSource.Fields
  includeLink = True
  If lnk.Kind <> 2 Then
    lnk.Select
    includeLink = False
    ' MsgBox "Different link kind"
  End If
  
  If lnk.Type <> 88 Then
    lnk.Select
    includeLink = False
    ' MsgBox "Different link type"
  End If
  
  If includeLink = True Then
    linkCode = lnk.Code
    myURL = Replace(linkCode, "HYPERLINK", "")
    myURL = Trim(Replace(myURL, """", ""))
    myVisibleText = lnk.Result
  '  lnk.ShowCodes = True
    rng.InsertAfter Text:=myVisibleText & vbTab
    startLink = rng.End
    rng.InsertAfter Text:=myURL & vbCr
    rng.End = rng.End - 1
    rng.start = startLink - 1
    rng.Font.Color = wdColorBlue
    rng.Font.Italic = True
    rng.start = rng.End + 1
  End If
Next lnk

Set rng = listDoc.Content
rng.ConvertToTable Separator:=wdSeparateByTabs
rng.Tables(1).Style = "Table Grid"
rng.Tables(1).AutoFitBehavior (wdAutoFitContent)
If deleteTableBorders = True Then
  rng.Tables(1).Borders(wdBorderTop).LineStyle = wdLineStyleNone
  rng.Tables(1).Borders(wdBorderLeft).LineStyle = wdLineStyleNone
  rng.Tables(1).Borders(wdBorderBottom).LineStyle = wdLineStyleNone
  rng.Tables(1).Borders(wdBorderRight).LineStyle = wdLineStyleNone
  rng.Tables(1).Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
  rng.Tables(1).Borders(wdBorderVertical).LineStyle = wdLineStyleNone
End If
Selection.HomeKey Unit:=wdStory
End Sub