Экспорт результатов поиска в новый документ - Microsoft Office Word

sn00pik · 12.09.2012, 23:52

Колеги подскажите, необходтмо из вордовского документа вытянуть все эмайлы, и сохранить оджельным документом

Sasha_Smirnov · 13.09.2012, 23:16

Вот. В приложенном документе (включив доступ к макросам) жмите F6. Там же и код: Alt-F11.

sn00pik · 14.09.2012, 10:47

Спасибо но я использовал этот код

Sub CopyAddressesToOtherDoc()
'извлекает все email из документа и размещает в новом документе столбиком
Dim Source As Document, Target As Document, myRange As Range
Set Source = ActiveDocument
Set Target = Documents.Add
Application.ScreenUpdating = False
Source.Activate
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:="[+0-9A-z._-]{1;}\@[A-z.]{1;}", _
MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True
Set myRange = Selection.Range
Target.Range.InsertAfter myRange & vbCr
Loop
End With
Selection.HomeKey Unit:=wdStory
Target.Activate
End Sub

12.09.2012, 23:52	#1
sn00pik Новичок Джуниор Регистрация: 12.09.2012 Сообщений: 2	Экспорт результатов поиска в новый документ Колеги подскажите, необходтмо из вордовского документа вытянуть все эмайлы, и сохранить оджельным документом

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
макрос для поиска позиций и вывода данных на лист поиска	mr-111	Microsoft Office Excel	12	13.03.2012 15:03
С++ Создать массив из результатов поиска	freeeeez	Помощь студентам	2	07.05.2011 01:06
Исключение поиска предыдущих результатов	MORPEH	Общие вопросы Delphi	2	08.12.2010 10:28
Поиск "проблемных значений" и вставка строки в новый документ Excel	Gvaridos	Microsoft Office Excel	5	16.11.2010 13:56
количество результатов поиска	memka	PHP	21	12.04.2009 15:41

14.09.2012, 10:47	#3
sn00pik Новичок Джуниор Регистрация: 12.09.2012 Сообщений: 2	Спасибо но я использовал этот код Sub CopyAddressesToOtherDoc() 'извлекает все email из документа и размещает в новом документе столбиком Dim Source As Document, Target As Document, myRange As Range Set Source = ActiveDocument Set Target = Documents.Add Application.ScreenUpdating = False Source.Activate Selection.HomeKey Unit:=wdStory Selection.Find.ClearFormatting With Selection.Find Do While .Execute(findText:="[+0-9A-z._-]{1;}\@[A-z.]{1;}", _ MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True Set myRange = Selection.Range Target.Range.InsertAfter myRange & vbCr Loop End With Selection.HomeKey Unit:=wdStory Target.Activate End Sub