Статьи из блога

Статьи из блога

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

Рубрика: Вопрос-Ответ, Макросы
Метки: |
Понедельник, 25 августа 2008 г.
Просмотров: 9303
Подписаться на комментарии по RSS
Версия для печати

[Ссылки на статью]

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

Как извлечь гиперссылки из документа Microsoft Office Word 2003 в другой документ? И если гиперссылок много, то выполнять вручную - это довольно утомительный процесс.

Для решения этой задачи можно воспользоваться двумя вариантами макросов. Но прежде, чем выполнять макросы, создайте в корне диска новую папку 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

twitter.com facebook.com vkontakte.ru odnoklassniki.ru mail.ru ya.ru rutvit.ru myspace.com technorati.com digg.com friendfeed.com pikabu.ru blogger.com liveinternet.ru livejournal.ru memori.ru google.com bobrdobr.ru mister-wong.ru yahoo.com yandex.ru del.icio.us

Еще записи по вопросам использования Microsoft Word:

Оставьте комментарий!

(обязательно)

^ Наверх