Sub ListHyperlinks()
Dim i As Long, strOut As String, f As Long
Const StrFlOut As String = "C:\Test1.txt"
With ActiveDocument
  For i = 1 To .Hyperlinks.Count
    strOut = strOut & Mid(.Hyperlinks(i).Address, 36, 75) & vbCr
  Next
End With
f = FreeFile()
Open StrFlOut For Output As #f
Print #f, strOut
Close #f
End Sub