Пакетный поиск в Яндексе с использованием Word

VERSION BUILD=8920312 RECORDER=FX
SET !VAR1 1
TAB OPEN NEW
ADD !VAR1 1
TAB T={{!VAR1}}
URL GOTO=http://yandex.ru/yandsearch?site=www.name.ru&text=Туэмлоу+Элис.+Графический+дизайн.+Фирменный+стиль.+Новейшие+технологии+и+креативные+идеи
TAB OPEN NEW
ADD !VAR1 1
TAB T={{!VAR1}}
URL GOTO=http://yandex.ru/yandsearch?site=www.name.ru&text=Айсмен+Л.+Дао+цвета
TAB OPEN NEW
ADD !VAR1 1
TAB T={{!VAR1}}
URL GOTO=http://yandex.ru/yandsearch?site=www.name.ru&text=Норман+Дональд+А.+Дизайн+вещей+будущего
TAB OPEN NEW
ADD !VAR1 1
TAB T={{!VAR1}}
URL GOTO=http://yandex.ru/yandsearch?site=www.name.ru&text=
TAB CLOSE

Sub MassYandexSearchInIMacros()
    Dim i As Integer
    Dim intSite As Integer
    Dim strSite As String
    Dim Name1 As String
    Dim MyPos As Integer
    Dim strYandex As String
    Dim strA As String
    Dim strDownloads As String
    
    'Формируем путь к папке макросов для Firefox
    Name1 = ActiveDocument.Name
    MyPos = InStrRev(Name1, ".")
    strDownloads = Environ("userprofile") + "\Documents\iMacros\Macros\Demo-Firefox\" + Left(Name1, MyPos - 1) + ".iim"
    'Указываем, будет ли проводиться поиск на определенном сайте или в интернете в целом.
    '(intSite = 1) - поиск на определенном сайте;
    '(intSite = 0) - поиск в интернете в целом.
    intSite = 1
    'Указываем URL сайта, на котором будет проводиться поиск.
    'Если (intSite = 0), то для переменной strSite можно указать любое значение.
    strSite = "www.name.ru"
    
    'Создаем переменную для формирования макроса Firefox
    If intSite = 1 Then
        strYandex = "http://yandex.ru/yandsearch?site=" + strSite + "&text="
    Else
        strYandex = "http://yandex.ru/yandsearch?text="
    End If
    strA = "^pTAB OPEN NEW^pADD !VAR1 1^pTAB T={{!VAR1}}^pURL GOTO=" + strYandex
    
    'Перенос данных в новое окно Word
    Selection.WholeStory
    Selection.Copy
    Documents.Add DocumentType:=wdNewBlankDocument
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.EndKey Unit:=wdStory
    Selection.TypeBackspace
    Selection.HomeKey Unit:=wdStory
    
    'Убираем лишние абзацы
    For i = 1 To 10
        With Selection.Find
            .Text = "^p^p"
            .Replacement.Text = "^p"
            .Forward = True
            .Wrap = wdFindContinue
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next i
     
    'Убираем лишние пробелы
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    For i = 1 To 5
        With Selection.Find
            .Text = "  "
            .Replacement.Text = " "
          .Forward = True
            .Wrap = wdFindContinue
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next i

    With Selection.Find
        .Text = " ^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    'Заменяем пробелы на +
    With Selection.Find
        .Text = " "
        .Replacement.Text = "+"
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.HomeKey Unit:=wdStory
    Selection.TypeParagraph
    Selection.MoveUp Unit:=wdLine, Count:=1
    Application.Keyboard (1033)
    Selection.TypeText Text:="VERSION BUILD=8920312 RECORDER=FX"
    Selection.TypeParagraph
    Selection.TypeText Text:="SET !VAR1 1"
    
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = strA
        .Forward = True
        .Wrap = wdFindStop
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    Selection.TypeText Text:="TAB CLOSE"

    'Открываем окно сохранения файла в папку макросов для Firefox
    With Dialogs(wdDialogFileSaveAs)
        .Name = strDownloads
        .Format = wdFormatText
        .Show
    End With

End Sub