Extract hyperlinks from Word document (in Word)

[Mindlesh]

How can I improve this macro to:
1. list hyperlinks in order of occurrence;
2. delete blank lines;
3. allow it to be terminated with the Esc key?

Function GetAllHyperlinks()
'[URL]https://www.extendoffice.com/documents/word/1411-word-select-copy-all-hyperlinks.html#a2[/URL]
'Updateby20140214
    Dim docCurrent As Document
    Dim docNew As Document
    Dim oLink As Hyperlink
    Dim rng As Range
    Application.ScreenUpdating = False
    Set docCurrent = ActiveDocument
    Set docNew = Documents.Add
    For Each oLink In docCurrent.Hyperlinks
        Set rng = docNew.Range
        rng.Collapse
        rng.InsertParagraph
        rng.InsertAfter (oLink.Address)
    Next
    docNew.Activate
    Application.ScreenUpdating = True
    Application.ScreenRefresh
End Function

 

[Macropod]

I suspect your code is outputting 'blanks' because it's not capturing hyperlink sub-addresses. Try:

Sub GetAllHyperlinks()
Application.ScreenUpdating = False
Dim i As Long, StrLnk As String
StrLnk = "Address" & vbTab & "Sub Address" & vbCr
With ActiveDocument
  If .Hyperlinks.Count = 0 Then Exit Sub
  For i = 1 To .Hyperlinks.Count
    With .Hyperlinks(i)
      StrLnk = StrLnk & .Address & vbTab & .SubAddress & vbCr
    End With
  Next
End With
Documents.Add
With ActiveDocument.Range
  .Text = StrLnk
  .ConvertToTable vbTab, 2
End With
Application.ScreenUpdating = True
End Sub

Note: Ordinarily, the code will execute so quickly you won't have time to press the Esc key before it terminates.

 

[Mindlesh]

    With [B][COLOR=#ff0000].[/COLOR][/B]Hyperlinks(i)

Thank you!