Извлечение гиперссылок из документа

Андрей интересуется:

Для решения этой задачи можно воспользоваться двумя вариантами макросов. Но прежде, чем выполнять макросы, создайте в корне диска новую папку Test, так как она будет использоваться для хранения нового документа.

Первый вариант - извлечь все текстовые ссылки в новый документ без изменения. То есть, если в вашем документе есть ссылки вида Скачать часть 1, то в новый документ они будут перенесены точно так же. Вот пример макроса:

Sub extractHyperlinks()
'Извлечение всех текстовых ссылок из документа и
'копирование их в новый документ
Dim oHpl As Hyperlink
Dim dAD As Document  'active document
Dim dDc As Document  'new document
Set dAD = ActiveDocument
Set dDc = Documents.Add(Visible:=False)
For Each oHpl In dAD.Hyperlinks
   oHpl.Range.Copy
   dDc.Activate
   Selection.Paste
   Selection.TypeParagraph
Next
dDc.SaveAs "C:\Test\hl.doc"
dDc.Close
Set dAD = Nothing
Set dDc = Nothing
End Sub

Второй вариант - извлечь только адреса ссылок без текста самой ссылки. То есть, если в вашем документе ссылка вида Скачать часть 1 ссылается на адрес типа http://wordexpert.ru/link.zip, то в новый документ будут вставлены исключительно адреса ссылок. Вот пример макроса:

Sub extractHyperlinks2()
'Извлечение всех адресов гиперссылок из документа и
'копирование их в новый документ
Dim oHpl As Hyperlink
Dim sAd As String
Dim dAD As Document  'active document
Dim dDc As Document  'new document
Set dAD = ActiveDocument
Set dDc = Documents.Add(Visible:=False)
For Each oHpl In dAD.Hyperlinks
   sAd = oHpl.Address
   dDc.Activate
   Selection.TypeText sAd & vbCr
Next
dDc.SaveAs "C:\Test\hl2.doc"
dDc.Close
Set dAD = Nothing
Set dDc = Nothing
End Sub