Dim fso As FileSystemObject ' Declare a FileSystemObject.
Dim stream As TextStream ' Declare a TextStream.
Sub Demo()
    
    Dim i As Long, Rng As Range
    Dim strMid As String

    Set fso = New FileSystemObject ' Create a FileSystemObject.
    Set stream = fso.CreateTextFile("C\Test1.txt", True)  ' Create a TextStream.
    
    Application.ScreenUpdating = False
    
    With ActiveDocument
        For i = .Hyperlinks.Count To 1 Step -1
            strMid = Mid(.Hyperlinks(i).Address, 36, 75) '& vbCr
            stream.WriteLine (strMid)
        Next
    End With
    
    ' Close the file.
    stream.Close

    Application.ScreenUpdating = True
    
End Sub